1 Librerías.

library(spatgeom)
library(RSDA)
## 
## 
## Attaching package: 'RSDA'
## The following objects are masked from 'package:stats':
## 
##     cor, sd, var
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(sf)
## Linking to GEOS 3.7.2, GDAL 3.0.4, PROJ 6.3.2; sf_use_s2() is TRUE
library(ggplot2)
library(readr)
library(plotly)
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
library(pracma)

2 Ejemplo 1. Datos simulados, modelo lineal.

n=100

x1.lower <- round(runif(n,0,2),2)
x1.upper <- x1.lower + round(runif(n,1,2))

x2.lower <- round(runif(n,0,2),2)
x2.upper <- x2.lower + round(runif(n,1,2))

x3.lower <- round(runif(n,0,2),2)
x3.upper <- x3.lower + round(runif(n,1,2))

x1.centers <- (x1.lower+x1.upper)/2
x2.centers <- (x2.lower+x2.upper)/2
x3.centers <- (x3.lower+x3.upper)/2

x1.ranks <- (x1.upper-x1.lower)/2
x2.ranks <- (x2.upper-x2.lower)/2
x3.ranks <- (x3.upper-x3.lower)/2

y.centers <- 0.6*x1.centers + 0.3*x2.centers + 0.1*x3.centers
y.ranks <- 0.6*x1.ranks + 0.3*x2.ranks + 0.1*x3.ranks

y.lower <- y.centers - y.ranks
y.upper <- y.centers + y.ranks

tabla <- data.frame(x1.lower,x1.upper,x2.lower,x2.upper,x3.lower,x3.upper,y.lower,y.upper, x1.centers, x1.ranks,x2.centers,x2.ranks,x3.centers,x3.ranks, y.centers, y.ranks)

#Gráficamente

library(patchwork)  

# Rectángulos (x1, y)
p1 <- ggplot(tabla, aes(xmin = x1.lower, xmax = x1.upper, ymin = y.lower, ymax = y.upper)) +
  geom_rect(fill = "skyblue", color = "black", alpha = 0.4) +
  geom_point(aes(x = x1.centers, y = y.centers), color = "red", size = 1) +
  labs(title = "Rectángulos en el plano (x1, y)", x = "x1", y = "y") +
  theme_minimal()

# (x2, y)
p2 <- ggplot(tabla, aes(xmin = x2.lower, xmax = x2.upper, ymin = y.lower, ymax = y.upper)) +
  geom_rect(fill = "palegreen", color = "black", alpha = 0.4) +
  geom_point(aes(x = x2.centers, y = y.centers), color = "red", size = 1) +
  labs(title = "Rectángulos en el plano (x2, y)", x = "x2", y = "y") +
  theme_minimal()

# (x3, y)
p3 <- ggplot(tabla, aes(xmin = x3.lower, xmax = x3.upper, ymin = y.lower, ymax = y.upper)) +
  geom_rect(fill = "salmon", color = "black", alpha = 0.4) +
  geom_point(aes(x = x3.centers, y = y.centers), color = "red", size = 1) +
  labs(title = "Rectángulos en el plano (x3, y)", x = "x3", y = "y") +
  theme_minimal()

p1

p2

p3

indice1 <- spatgeom(y=tabla$y.centers, x=tabla[,c("x1.centers","x2.centers","x3.centers")]) 
## Running with x and y
## Index estimation
## Estimating R2 Geom for variable = 1
## Estimating R2 Geom for variable = 2
## Estimating R2 Geom for variable = 3
plot_curve(indice1, type = "curve")

plot_curve(indice1, type = "deriv")

indice2 <- spatgeom(y=tabla$y.lower, x=tabla[,c("x1.lower","x2.lower","x3.lower")]) 
## Running with x and y
## Index estimation
## Estimating R2 Geom for variable = 1
## Estimating R2 Geom for variable = 2
## Estimating R2 Geom for variable = 3
plot_curve(indice2, type = "curve")

plot_curve(indice2, type = "deriv")

indice3 <- spatgeom(y=tabla$y.upper, x=tabla[,c("x1.upper","x2.upper","x3.upper")]) 
## Running with x and y
## Index estimation
## Estimating R2 Geom for variable = 1
## Estimating R2 Geom for variable = 2
## Estimating R2 Geom for variable = 3
plot_curve(indice3, type = "curve")

plot_curve(indice3, type = "deriv")

3 Para la variable \(x_{1}\).

geom_indicesc <- indice1$results[[1]]$geom_indices 
geom_indicescmenosr <- indice2$results[[1]]$geom_indices
geom_indicescmasr <- indice3$results[[1]]$geom_indices

geom_indicescmenosr1 <- geom_indicescmenosr %>% group_by(alpha) %>% filter(geom_corr==max(geom_corr)) %>% ungroup() 

geom_indicescmasr1 <- geom_indicescmasr %>% group_by(alpha) %>% filter(geom_corr==max(geom_corr)) %>% ungroup() 

geom_indicesc$label <- "centros"
geom_indicescmenosr$label <- "centros menos rangos"
geom_indicescmasr$label <- "centros más rangos"

data_combined <- rbind(geom_indicesc,geom_indicescmenosr,geom_indicescmasr)
data_combined1 <- rbind(geom_indicescmenosr1, geom_indicescmasr1)
data_combined1 <- rbind(c(0,1),data_combined1)

ggplotly(ggplot(data_combined, aes(x = alpha, y = geom_corr, color = label)) +
  geom_step(size = 1) +
  labs(
    title = "Correlación geométrica con datos uniformes",
    x = "Alpha",
    y = "Geom_corr",
    color = "Curvas"
  ) +
  theme_minimal() +
  theme(legend.position = "bottom"))
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
#Área acumulada entre las curvas: centros menos rangos y centros más rangos.

library(pracma)

alpha.vals <- sort(unique(c(geom_indicescmenosr1$alpha, geom_indicescmasr1$alpha)))

geom_corr.cmasr <- approx(geom_indicescmasr1$alpha, geom_indicescmasr1$geom_corr, xout = alpha.vals, rule = 2)$y

geom_corr.cmenosr <- approx(geom_indicescmenosr1$alpha, geom_indicescmenosr1$geom_corr, xout = alpha.vals, rule = 2)$y

diff.geom_corr <- geom_corr.cmasr - geom_corr.cmenosr

table.cmasr <- cbind(alpha.vals, geom_corr.cmasr)
table.cmenosr <- cbind(alpha.vals, geom_corr.cmenosr)
table.diff <- cbind(alpha.vals, diff.geom_corr)
table.diff
##         alpha.vals diff.geom_corr
##   [1,] 0.006403124  -6.118289e-06
##   [2,] 0.011000000   2.696153e-05
##   [3,] 0.026500000   1.066538e-04
##   [4,] 0.027856777   1.564911e-04
##   [5,] 0.028792360   1.858687e-04
##   [6,] 0.030500000   2.594634e-04
##   [7,] 0.030675723   3.246862e-04
##   [8,] 0.030805844   4.292464e-04
##   [9,] 0.031764760   6.722323e-04
##  [10,] 0.032649655   9.877870e-04
##  [11,] 0.035032128   1.095374e-03
##  [12,] 0.036619667   1.159084e-03
##  [13,] 0.037696154   1.311225e-03
##  [14,] 0.038160844   1.412498e-03
##  [15,] 0.040012498   1.756081e-03
##  [16,] 0.040311289   1.782774e-03
##  [17,] 0.040816663   1.829525e-03
##  [18,] 0.042201896   2.065869e-03
##  [19,] 0.042216703   2.617354e-03
##  [20,] 0.042252219   2.848080e-03
##  [21,] 0.042426407   3.087585e-03
##  [22,] 0.042438190   3.395552e-03
##  [23,] 0.042898135   3.649410e-03
##  [24,] 0.043139309   3.853019e-03
##  [25,] 0.043660623   4.298264e-03
##  [26,] 0.044821870   4.840319e-03
##  [27,] 0.045069391   5.260976e-03
##  [28,] 0.046446205   6.087293e-03
##  [29,] 0.046960089   6.574999e-03
##  [30,] 0.047087684   7.373194e-03
##  [31,] 0.047563116   7.762183e-03
##  [32,] 0.047762433   7.908817e-03
##  [33,] 0.048383882   8.360825e-03
##  [34,] 0.050022495   9.365393e-03
##  [35,] 0.050159745   1.041492e-02
##  [36,] 0.050358713   1.115034e-02
##  [37,] 0.050990195   1.197852e-02
##  [38,] 0.051662365   1.307496e-02
##  [39,] 0.052354560   1.390031e-02
##  [40,] 0.052430907   1.397356e-02
##  [41,] 0.052680642   1.388489e-02
##  [42,] 0.052841745   1.402522e-02
##  [43,] 0.053667961   1.419416e-02
##  [44,] 0.053851648   1.495577e-02
##  [45,] 0.054120237   1.520881e-02
##  [46,] 0.054600824   1.538695e-02
##  [47,] 0.054644304   1.481873e-02
##  [48,] 0.055020451   1.475735e-02
##  [49,] 0.055056789   1.487447e-02
##  [50,] 0.055145263   1.515439e-02
##  [51,] 0.055454937   1.516320e-02
##  [52,] 0.055509008   1.517786e-02
##  [53,] 0.055832338   1.515976e-02
##  [54,] 0.055901699   1.630065e-02
##  [55,] 0.056189412   1.773492e-02
##  [56,] 0.056293872   1.778004e-02
##  [57,] 0.056703175   1.877597e-02
##  [58,] 0.056797887   1.900861e-02
##  [59,] 0.057008771   1.992377e-02
##  [60,] 0.057116110   2.040007e-02
##  [61,] 0.057404268   2.157914e-02
##  [62,] 0.057870545   2.280508e-02
##  [63,] 0.057974132   2.289241e-02
##  [64,] 0.058148517   2.266528e-02
##  [65,] 0.059002119   2.317638e-02
##  [66,] 0.059052942   2.322531e-02
##  [67,] 0.059600755   2.441953e-02
##  [68,] 0.060299254   2.458108e-02
##  [69,] 0.060827625   2.476379e-02
##  [70,] 0.060911822   2.575712e-02
##  [71,] 0.061491869   2.630082e-02
##  [72,] 0.061491869   2.630082e-02
##  [73,] 0.062201286   2.666085e-02
##  [74,] 0.062801274   2.677900e-02
##  [75,] 0.063158531   2.649514e-02
##  [76,] 0.063198101   2.680937e-02
##  [77,] 0.063294945   2.702761e-02
##  [78,] 0.063631753   2.763639e-02
##  [79,] 0.063641574   2.763707e-02
##  [80,] 0.063994140   2.803949e-02
##  [81,] 0.064437955   2.914692e-02
##  [82,] 0.064693508   2.934165e-02
##  [83,] 0.064809336   2.943948e-02
##  [84,] 0.065069194   2.950416e-02
##  [85,] 0.065094163   2.956546e-02
##  [86,] 0.065192024   3.098250e-02
##  [87,] 0.066001894   3.140167e-02
##  [88,] 0.066009469   3.140059e-02
##  [89,] 0.066098411   3.138928e-02
##  [90,] 0.066387122   3.161825e-02
##  [91,] 0.066640828   3.225138e-02
##  [92,] 0.066753277   3.321284e-02
##  [93,] 0.067529623   3.378145e-02
##  [94,] 0.067581432   3.470257e-02
##  [95,] 0.067603624   3.473862e-02
##  [96,] 0.068014704   3.539369e-02
##  [97,] 0.068900290   3.624195e-02
##  [98,] 0.069500000   3.652106e-02
##  [99,] 0.070087445   3.678143e-02
## [100,] 0.070301138   3.816866e-02
## [101,] 0.072277244   3.856071e-02
## [102,] 0.072527581   3.862762e-02
## [103,] 0.072670489   3.968742e-02
## [104,] 0.073015409   4.051657e-02
## [105,] 0.073681748   4.167336e-02
## [106,] 0.074546965   4.184105e-02
## [107,] 0.074546965   4.184105e-02
## [108,] 0.075000000   4.154881e-02
## [109,] 0.075208045   4.131676e-02
## [110,] 0.075208045   4.479916e-02
## [111,] 0.075325958   4.475621e-02
## [112,] 0.075802375   4.583546e-02
## [113,] 0.076216796   4.631638e-02
## [114,] 0.076500000   4.665878e-02
## [115,] 0.076557168   4.627090e-02
## [116,] 0.076609399   4.632900e-02
## [117,] 0.077162167   4.701601e-02
## [118,] 0.077388630   4.817735e-02
## [119,] 0.077828337   5.002006e-02
## [120,] 0.078262379   5.251412e-02
## [121,] 0.078461774   5.251683e-02
## [122,] 0.078492038   5.192212e-02
## [123,] 0.078773409   5.107582e-02
## [124,] 0.079323704   5.123663e-02
## [125,] 0.079342612   5.007171e-02
## [126,] 0.079657078   5.006685e-02
## [127,] 0.080263628   5.087534e-02
## [128,] 0.080721744   5.230496e-02
## [129,] 0.081610355   5.408661e-02
## [130,] 0.081891697   5.668546e-02
## [131,] 0.082000000   5.783802e-02
## [132,] 0.082384768   6.186581e-02
## [133,] 0.082947272   6.230700e-02
## [134,] 0.083103851   6.231279e-02
## [135,] 0.083798866   6.187334e-02
## [136,] 0.083815273   6.186064e-02
## [137,] 0.084559151   6.120535e-02
## [138,] 0.084824819   6.109828e-02
## [139,] 0.085248167   6.130120e-02
## [140,] 0.085328776   6.033051e-02
## [141,] 0.085616879   6.027363e-02
## [142,] 0.085912746   6.184319e-02
## [143,] 0.086204698   6.198819e-02
## [144,] 0.086227896   6.072567e-02
## [145,] 0.086227896   6.072567e-02
## [146,] 0.086278618   6.037449e-02
## [147,] 0.086863399   6.160163e-02
## [148,] 0.086989942   6.069710e-02
## [149,] 0.087097646   6.090516e-02
## [150,] 0.087458562   6.121579e-02
## [151,] 0.088255311   6.153403e-02
## [152,] 0.089140339   6.236818e-02
## [153,] 0.089269256   6.254565e-02
## [154,] 0.090138782   6.488358e-02
## [155,] 0.090138782   6.488358e-02
## [156,] 0.091685604   6.770559e-02
## [157,] 0.093017471   6.971890e-02
## [158,] 0.093107465   6.687732e-02
## [159,] 0.093178592   6.698685e-02
## [160,] 0.093553461   6.841016e-02
## [161,] 0.095117033   6.872797e-02
## [162,] 0.095524866   6.808070e-02
## [163,] 0.096130120   6.772714e-02
## [164,] 0.097186676   6.798047e-02
## [165,] 0.097325485   7.048992e-02
## [166,] 0.097514102   7.512871e-02
## [167,] 0.098184775   7.825055e-02
## [168,] 0.098508883   8.072670e-02
## [169,] 0.099575348   8.452323e-02
## [170,] 0.100101199   8.504184e-02
## [171,] 0.100623059   8.470518e-02
## [172,] 0.100778222   8.396430e-02
## [173,] 0.101212647   8.441307e-02
## [174,] 0.102415819   8.519613e-02
## [175,] 0.103077641   8.547402e-02
## [176,] 0.103712343   8.499195e-02
## [177,] 0.104000000   8.439348e-02
## [178,] 0.105475116   8.431838e-02
## [179,] 0.105905618   8.524624e-02
## [180,] 0.105990566   8.547258e-02
## [181,] 0.107070071   8.763472e-02
## [182,] 0.107178589   9.090856e-02
## [183,] 0.108632408   9.795452e-02
## [184,] 0.108908218   1.025224e-01
## [185,] 0.110163515   1.052431e-01
## [186,] 0.110205490   1.045477e-01
## [187,] 0.110222502   1.030570e-01
## [188,] 0.110500000   9.958888e-02
## [189,] 0.110613064   9.978326e-02
## [190,] 0.111230616   1.015046e-01
## [191,] 0.111507847   1.052727e-01
## [192,] 0.112044634   1.079951e-01
## [193,] 0.112695386   1.113777e-01
## [194,] 0.112787411   1.118156e-01
## [195,] 0.113715654   1.128297e-01
## [196,] 0.114127122   1.134752e-01
## [197,] 0.114284732   1.135297e-01
## [198,] 0.114808536   1.149364e-01
## [199,] 0.115004348   1.158518e-01
## [200,] 0.115524889   1.171420e-01
## [201,] 0.115932092   1.162076e-01
## [202,] 0.116914499   1.187607e-01
## [203,] 0.117517020   1.205514e-01
## [204,] 0.118013770   1.206411e-01
## [205,] 0.118309974   1.175630e-01
## [206,] 0.118431415   1.160874e-01
## [207,] 0.119189974   1.155850e-01
## [208,] 0.120016666   1.169156e-01
## [209,] 0.120016666   1.169156e-01
## [210,] 0.120203993   1.183568e-01
## [211,] 0.120440857   1.222073e-01
## [212,] 0.120917327   1.245974e-01
## [213,] 0.120933866   1.246671e-01
## [214,] 0.121594613   1.270318e-01
## [215,] 0.121594613   1.270318e-01
## [216,] 0.121597697   1.253183e-01
## [217,] 0.122576507   1.253014e-01
## [218,] 0.122918672   1.244533e-01
## [219,] 0.123693169   1.241962e-01
## [220,] 0.123916302   1.241683e-01
## [221,] 0.124233651   1.292127e-01
## [222,] 0.125905719   1.298872e-01
## [223,] 0.126178445   1.287585e-01
## [224,] 0.126289350   1.272850e-01
## [225,] 0.126822711   1.272064e-01
## [226,] 0.127059041   1.268223e-01
## [227,] 0.127059041   1.255831e-01
## [228,] 0.127910125   1.242499e-01
## [229,] 0.128363741   1.240880e-01
## [230,] 0.128538905   1.242011e-01
## [231,] 0.130000000   1.239049e-01
## [232,] 0.130648383   1.232889e-01
## [233,] 0.130981869   1.228468e-01
## [234,] 0.131359240   1.215404e-01
## [235,] 0.133761915   1.219962e-01
## [236,] 0.133869339   1.226114e-01
## [237,] 0.134202273   1.227895e-01
## [238,] 0.134402381   1.232005e-01
## [239,] 0.134792433   1.216889e-01
## [240,] 0.134871235   1.214059e-01
## [241,] 0.135333846   1.204540e-01
## [242,] 0.135447407   1.176533e-01
## [243,] 0.136701317   1.165274e-01
## [244,] 0.139316187   1.161360e-01
## [245,] 0.140000893   1.154790e-01
## [246,] 0.140204315   1.138396e-01
## [247,] 0.140375390   1.131028e-01
## [248,] 0.140520461   1.165116e-01
## [249,] 0.140578270   1.181732e-01
## [250,] 0.141223228   1.211557e-01
## [251,] 0.142538591   1.291563e-01
## [252,] 0.143461667   1.298753e-01
## [253,] 0.144779142   1.282546e-01
## [254,] 0.145455320   1.258019e-01
## [255,] 0.145627092   1.238630e-01
## [256,] 0.145723197   1.247209e-01
## [257,] 0.145880088   1.228512e-01
## [258,] 0.147678705   1.234052e-01
## [259,] 0.148141824   1.227834e-01
## [260,] 0.148291099   1.180555e-01
## [261,] 0.148846397   1.167079e-01
## [262,] 0.149495819   1.162115e-01
## [263,] 0.151792622   1.169389e-01
## [264,] 0.153733536   1.236024e-01
## [265,] 0.154155765   1.257370e-01
## [266,] 0.155724918   1.262382e-01
## [267,] 0.160078106   1.282938e-01
## [268,] 0.160920011   1.277422e-01
## [269,] 0.161721984   1.274226e-01
## [270,] 0.164924225   1.275728e-01
## [271,] 0.165075740   1.270568e-01
## [272,] 0.165822948   1.263050e-01
## [273,] 0.165847068   1.222050e-01
## [274,] 0.167039666   1.222707e-01
## [275,] 0.167377567   1.184289e-01
## [276,] 0.169189243   1.180886e-01
## [277,] 0.170472872   1.195615e-01
## [278,] 0.171026314   1.140779e-01
## [279,] 0.171354165   1.140657e-01
## [280,] 0.171421265   1.142153e-01
## [281,] 0.172046505   1.202375e-01
## [282,] 0.172154727   1.230008e-01
## [283,] 0.177545065   1.283057e-01
## [284,] 0.180017360   1.393743e-01
## [285,] 0.181176709   1.434686e-01
## [286,] 0.182608872   1.440862e-01
## [287,] 0.184361059   1.450162e-01
## [288,] 0.185326738   1.443107e-01
## [289,] 0.187235814   1.448591e-01
## [290,] 0.189423467   1.464074e-01
## [291,] 0.193124960   1.457265e-01
## [292,] 0.193287998   1.419268e-01
## [293,] 0.197689782   1.386892e-01
## [294,] 0.200124961   1.377101e-01
## [295,] 0.208583916   1.356015e-01
## [296,] 0.211733913   1.355028e-01
## [297,] 0.214683488   1.371308e-01
## [298,] 0.215195260   1.373521e-01
## [299,] 0.221317080   1.359459e-01
## [300,] 0.221472346   1.360027e-01
## [301,] 0.227705951   1.357827e-01
## [302,] 0.229907046   1.334352e-01
## [303,] 0.234534113   1.324864e-01
## [304,] 0.238227307   1.285400e-01
## [305,] 0.240881714   1.230406e-01
## [306,] 0.243507700   1.177407e-01
## [307,] 0.245538184   1.131470e-01
## [308,] 0.245728000   1.105467e-01
## [309,] 0.252666282   1.115192e-01
## [310,] 0.255141627   1.067688e-01
## [311,] 0.255970701   1.029059e-01
## [312,] 0.256048823   1.025725e-01
## [313,] 0.258677405   9.937900e-02
## [314,] 0.259108568   9.925250e-02
## [315,] 0.264756492   9.649525e-02
## [316,] 0.271463165   8.849575e-02
## [317,] 0.273507313   8.357715e-02
## [318,] 0.274200656   8.181765e-02
## [319,] 0.277477927   6.861526e-02
## [320,] 0.285273991   6.152571e-02
## [321,] 0.290924818   6.104174e-02
## [322,] 0.291686476   6.081232e-02
## [323,] 0.297793553   5.954309e-02
## [324,] 0.334570247   5.539550e-02
## [325,] 0.365815527   4.127402e-02
## [326,] 0.372013441   4.141517e-02
## [327,] 0.403886123   4.311658e-02
## [328,] 0.433159613   4.477267e-02
## [329,] 0.481923230   4.553141e-02
## [330,] 0.482566317   5.131291e-02
## [331,] 0.503791872   5.379601e-02
## [332,] 0.514796319   4.542341e-02
## [333,] 0.541742790   4.960164e-02
## [334,] 0.553754458   4.899256e-02
## [335,] 0.589091674   4.811889e-02
## [336,] 0.780688959   4.183992e-02
## [337,] 0.927340822   3.622333e-02
## [338,] 0.954564822   3.314736e-02
ggplot(table.diff, aes(x=alpha.vals, diff.geom_corr))+geom_point()

area.acumulada <- cumsum(c(0, diff.geom_corr[-1] * diff(alpha.vals))) 
area.acumulada #analizar esto
##   [1] 0.000000e+00 1.239388e-07 1.777073e-06 1.989397e-06 2.163292e-06
##   [6] 2.606362e-06 2.663417e-06 2.719271e-06 3.363886e-06 4.237974e-06
##  [11] 6.847673e-06 8.687764e-06 1.009928e-05 1.075566e-05 1.400731e-05
##  [16] 1.453999e-05 1.546458e-05 1.832629e-05 1.836505e-05 1.846620e-05
##  [21] 1.900402e-05 1.904403e-05 2.072256e-05 2.165181e-05 2.389255e-05
##  [26] 2.951335e-05 3.081556e-05 3.919663e-05 4.257542e-05 4.351620e-05
##  [31] 4.720659e-05 4.878295e-05 5.397877e-05 6.932503e-05 7.075448e-05
##  [36] 7.297304e-05 8.053726e-05 8.932586e-05 9.894758e-05 1.000144e-04
##  [41] 1.034820e-04 1.057415e-04 1.174689e-04 1.202161e-04 1.243010e-04
##  [46] 1.316958e-04 1.323401e-04 1.378910e-04 1.384315e-04 1.397723e-04
##  [51] 1.444679e-04 1.452886e-04 1.501902e-04 1.513209e-04 1.564234e-04
##  [56] 1.582807e-04 1.659658e-04 1.677662e-04 1.719678e-04 1.741575e-04
##  [61] 1.803757e-04 1.910092e-04 1.933805e-04 1.973330e-04 2.171164e-04
##  [66] 2.182968e-04 2.316741e-04 2.488440e-04 2.619285e-04 2.640971e-04
##  [71] 2.793528e-04 2.793528e-04 2.982665e-04 3.143336e-04 3.237991e-04
##  [76] 3.248600e-04 3.274774e-04 3.367856e-04 3.370570e-04 3.469428e-04
##  [81] 3.598786e-04 3.673770e-04 3.707869e-04 3.784538e-04 3.791920e-04
##  [86] 3.822240e-04 4.076553e-04 4.078931e-04 4.106850e-04 4.198135e-04
##  [91] 4.279959e-04 4.317306e-04 4.579567e-04 4.597546e-04 4.605255e-04
##  [96] 4.750752e-04 5.071705e-04 5.290726e-04 5.506797e-04 5.588360e-04
## [101] 6.350361e-04 6.447060e-04 6.503776e-04 6.643526e-04 6.921212e-04
## [106] 7.283228e-04 7.283228e-04 7.471458e-04 7.557416e-04 7.557416e-04
## [111] 7.610189e-04 7.828557e-04 8.020502e-04 8.152642e-04 8.179094e-04
## [116] 8.203292e-04 8.463181e-04 8.572285e-04 8.792227e-04 9.020160e-04
## [121] 9.124876e-04 9.140590e-04 9.284303e-04 9.566255e-04 9.575722e-04
## [126] 9.733166e-04 1.004175e-03 1.028137e-03 1.076199e-03 1.092147e-03
## [131] 1.098411e-03 1.122215e-03 1.157263e-03 1.167020e-03 1.210022e-03
## [136] 1.211037e-03 1.256567e-03 1.272799e-03 1.298750e-03 1.303613e-03
## [141] 1.320979e-03 1.339276e-03 1.357373e-03 1.358782e-03 1.358782e-03
## [146] 1.361844e-03 1.397868e-03 1.405549e-03 1.412108e-03 1.434202e-03
## [151] 1.483229e-03 1.538427e-03 1.546490e-03 1.602908e-03 1.602908e-03
## [156] 1.707637e-03 1.800493e-03 1.806511e-03 1.811276e-03 1.836921e-03
## [161] 1.944382e-03 1.972148e-03 2.013140e-03 2.084965e-03 2.094750e-03
## [166] 2.108920e-03 2.161401e-03 2.187565e-03 2.277706e-03 2.322425e-03
## [171] 2.366629e-03 2.379658e-03 2.416329e-03 2.518834e-03 2.575403e-03
## [176] 2.629347e-03 2.653624e-03 2.778003e-03 2.814702e-03 2.821963e-03
## [181] 2.916565e-03 2.926430e-03 3.068838e-03 3.097115e-03 3.229226e-03
## [186] 3.233614e-03 3.235368e-03 3.263003e-03 3.274285e-03 3.336970e-03
## [191] 3.366155e-03 3.424125e-03 3.496604e-03 3.506894e-03 3.611627e-03
## [196] 3.658319e-03 3.676212e-03 3.736416e-03 3.759101e-03 3.820079e-03
## [201] 3.867399e-03 3.984070e-03 4.056705e-03 4.116633e-03 4.151456e-03
## [206] 4.165554e-03 4.253232e-03 4.349885e-03 4.349885e-03 4.372056e-03
## [211] 4.401003e-03 4.460370e-03 4.462432e-03 4.546368e-03 4.546368e-03
## [216] 4.546754e-03 4.669400e-03 4.711984e-03 4.808173e-03 4.835880e-03
## [221] 4.876885e-03 5.094065e-03 5.129181e-03 5.143298e-03 5.211144e-03
## [226] 5.241116e-03 5.241116e-03 5.346863e-03 5.403152e-03 5.424907e-03
## [231] 5.605944e-03 5.685883e-03 5.726850e-03 5.772716e-03 6.065833e-03
## [236] 6.079005e-03 6.119886e-03 6.144539e-03 6.192004e-03 6.201571e-03
## [241] 6.257294e-03 6.270655e-03 6.416770e-03 6.720451e-03 6.799520e-03
## [246] 6.822677e-03 6.842026e-03 6.858929e-03 6.865760e-03 6.943901e-03
## [251] 7.113788e-03 7.233673e-03 7.402645e-03 7.487710e-03 7.508986e-03
## [256] 7.520972e-03 7.540246e-03 7.762205e-03 7.819068e-03 7.836691e-03
## [261] 7.901499e-03 7.976969e-03 8.245555e-03 8.485456e-03 8.538546e-03
## [266] 8.736633e-03 9.295120e-03 9.402667e-03 9.504856e-03 9.913375e-03
## [271] 9.932626e-03 1.002700e-02 1.002995e-02 1.017577e-02 1.021579e-02
## [276] 1.042973e-02 1.058320e-02 1.064633e-02 1.068373e-02 1.069139e-02
## [281] 1.076657e-02 1.077988e-02 1.147149e-02 1.181607e-02 1.198240e-02
## [286] 1.218875e-02 1.244285e-02 1.258221e-02 1.285875e-02 1.317904e-02
## [291] 1.371845e-02 1.374159e-02 1.435207e-02 1.468742e-02 1.583446e-02
## [296] 1.626130e-02 1.666577e-02 1.673607e-02 1.756830e-02 1.758942e-02
## [301] 1.843584e-02 1.872954e-02 1.934256e-02 1.981729e-02 2.014389e-02
## [306] 2.045307e-02 2.068281e-02 2.070380e-02 2.147755e-02 2.174184e-02
## [311] 2.182716e-02 2.183517e-02 2.209639e-02 2.213919e-02 2.268419e-02
## [316] 2.327770e-02 2.344854e-02 2.350527e-02 2.373014e-02 2.420980e-02
## [321] 2.455474e-02 2.460105e-02 2.496469e-02 2.700195e-02 2.829157e-02
## [326] 2.854826e-02 2.992250e-02 3.123315e-02 3.345343e-02 3.348643e-02
## [331] 3.462828e-02 3.512814e-02 3.646473e-02 3.705321e-02 3.875360e-02
## [336] 4.677001e-02 5.208223e-02 5.298463e-02
data.acumulada <- data.frame(alpha = alpha.vals, area = area.acumulada)
head(data.acumulada)
##         alpha         area
## 1 0.006403124 0.000000e+00
## 2 0.011000000 1.239388e-07
## 3 0.026500000 1.777073e-06
## 4 0.027856777 1.989397e-06
## 5 0.028792360 2.163292e-06
## 6 0.030500000 2.606362e-06
p <- ggplot(data.acumulada, aes(x = alpha, y = area.acumulada)) +
  geom_line(size = 1, color = "blue") +
  labs(
    title = "Área Acumulada entre las Curvas",
    x = "Alpha",
    y = "Área Acumulada"
  ) +
  theme_minimal()

 ggplotly(p)
# Derivada.

tasa.cambio <- diff(area.acumulada) / diff(alpha.vals)
alpha.medios <- (alpha.vals[-1] + alpha.vals[-length(alpha.vals)])/2
data.derivada <- data.frame(alpha = alpha.medios, tasadecambio = tasa.cambio)

p.derivada <- ggplot(data.derivada, aes(x = alpha, y = tasa.cambio)) +
  geom_line(size = 1, color = "red") +
  labs(
    title = "Tasa de Cambio de la Función Acumulada",
    x = "Alpha",
    y = "Derivada (Tasa de Cambio)"
  ) +
  theme_minimal()

ggplotly(p.derivada)

4 Para la variable \(x_{2}\).

geom_indicesc <- indice1$results[[2]]$geom_indices 
geom_indicescmenosr <- indice2$results[[2]]$geom_indices
geom_indicescmasr <- indice3$results[[2]]$geom_indices

geom_indicescmenosr2 <- geom_indicescmenosr %>% group_by(alpha) %>% filter(geom_corr==max(geom_corr)) %>% ungroup() 

geom_indicescmasr2 <- geom_indicescmasr %>% group_by(alpha) %>% filter(geom_corr==max(geom_corr)) %>% ungroup() 

geom_indicesc$label <- "centros"
geom_indicescmenosr$label <- "centros menos rangos"
geom_indicescmasr$label <- "centros más rangos"

data_combined <- rbind(geom_indicesc,geom_indicescmenosr,geom_indicescmasr)
data_combined1 <- rbind(geom_indicescmenosr2, geom_indicescmasr2)
data_combined1 <- rbind(c(0,1),data_combined1)

ggplotly(ggplot(data_combined, aes(x = alpha, y = geom_corr, color = label)) +
  geom_step(size = 1) +
  labs(
    title = "Correlación geométrica con datos uniformes",
    x = "Alpha",
    y = "Geom_corr",
    color = "Curvas"
  ) +
  theme_minimal() +
  theme(legend.position = "bottom"))
alpha.vals <- sort(unique(c(geom_indicescmenosr2$alpha, geom_indicescmasr2$alpha)))
geom_corr.cmasr <- approx(geom_indicescmasr2$alpha, geom_indicescmasr2$geom_corr, xout = alpha.vals, rule = 2)$y
geom_corr.cmenosr <- approx(geom_indicescmenosr2$alpha, geom_indicescmenosr2$geom_corr, xout = alpha.vals, rule = 2)$y

diff.geom_corr <- geom_corr.cmasr - geom_corr.cmenosr

table.cmasr <- cbind(alpha.vals, geom_corr.cmasr)
table.cmenosr <- cbind(alpha.vals, geom_corr.cmenosr)
table.diff <- cbind(alpha.vals, diff.geom_corr)
table.diff
##        alpha.vals diff.geom_corr
##   [1,] 0.02018044   4.919256e-05
##   [2,] 0.02147091   1.394103e-04
##   [3,] 0.02470324   2.100808e-04
##   [4,] 0.02540177   2.195322e-04
##   [5,] 0.02692582   2.253926e-04
##   [6,] 0.03041381   4.998547e-04
##   [7,] 0.03376759   5.530796e-04
##   [8,] 0.03579455   7.499706e-04
##   [9,] 0.03946201   9.730748e-04
##  [10,] 0.03992493   1.060742e-03
##  [11,] 0.04200000   1.391576e-03
##  [12,] 0.04294182   1.588818e-03
##  [13,] 0.04382921   1.615168e-03
##  [14,] 0.04810405   1.708986e-03
##  [15,] 0.05001000   1.731744e-03
##  [16,] 0.05020956   1.478886e-03
##  [17,] 0.05093133   1.325416e-03
##  [18,] 0.05380753   1.364250e-03
##  [19,] 0.05749130   1.795422e-03
##  [20,] 0.05996040   2.068730e-03
##  [21,] 0.06067125   2.487251e-03
##  [22,] 0.06250000   3.165127e-03
##  [23,] 0.06280127   3.263559e-03
##  [24,] 0.06280127   5.188203e-03
##  [25,] 0.06469351   5.481444e-03
##  [26,] 0.06469351   5.481444e-03
##  [27,] 0.06470896   6.919279e-03
##  [28,] 0.06719561   7.827879e-03
##  [29,] 0.07011419   8.022038e-03
##  [30,] 0.07097359   9.873732e-03
##  [31,] 0.07102112   9.976035e-03
##  [32,] 0.07180007   1.215710e-02
##  [33,] 0.07294004   1.266270e-02
##  [34,] 0.07426473   1.414962e-02
##  [35,] 0.07432362   1.616300e-02
##  [36,] 0.07544700   1.739761e-02
##  [37,] 0.07566538   1.743813e-02
##  [38,] 0.07615773   1.674220e-02
##  [39,] 0.07788453   1.662443e-02
##  [40,] 0.07826238   1.663864e-02
##  [41,] 0.07864636   1.666709e-02
##  [42,] 0.08062258   1.690682e-02
##  [43,] 0.08062258   1.814581e-02
##  [44,] 0.08068612   1.877362e-02
##  [45,] 0.08095678   2.097067e-02
##  [46,] 0.08137721   2.266459e-02
##  [47,] 0.08139410   2.415320e-02
##  [48,] 0.08139410   2.415320e-02
##  [49,] 0.08231191   2.518693e-02
##  [50,] 0.08271034   2.739085e-02
##  [51,] 0.08276473   2.769444e-02
##  [52,] 0.08341013   2.885954e-02
##  [53,] 0.08403719   3.039848e-02
##  [54,] 0.08403719   3.039848e-02
##  [55,] 0.08509407   3.123306e-02
##  [56,] 0.08575547   3.248788e-02
##  [57,] 0.08597819   3.261806e-02
##  [58,] 0.08608281   3.328947e-02
##  [59,] 0.08640168   3.338397e-02
##  [60,] 0.08703591   3.444838e-02
##  [61,] 0.08914034   3.945706e-02
##  [62,] 0.08995693   4.061082e-02
##  [63,] 0.09024411   4.101159e-02
##  [64,] 0.09055385   4.139006e-02
##  [65,] 0.09058835   4.795386e-02
##  [66,] 0.09073175   4.898471e-02
##  [67,] 0.09106179   5.183673e-02
##  [68,] 0.09150000   5.398139e-02
##  [69,] 0.09178780   5.496530e-02
##  [70,] 0.09212627   5.742675e-02
##  [71,] 0.09222391   5.904757e-02
##  [72,] 0.09222391   5.904757e-02
##  [73,] 0.09222391   6.107897e-02
##  [74,] 0.09250541   6.045016e-02
##  [75,] 0.09257564   5.944555e-02
##  [76,] 0.09388956   5.999833e-02
##  [77,] 0.09396276   6.173392e-02
##  [78,] 0.09406912   6.477898e-02
##  [79,] 0.09501184   6.549232e-02
##  [80,] 0.09502105   6.970401e-02
##  [81,] 0.09512623   7.694608e-02
##  [82,] 0.09529428   7.752185e-02
##  [83,] 0.09552487   7.693440e-02
##  [84,] 0.09552487   7.693440e-02
##  [85,] 0.09602213   7.950099e-02
##  [86,] 0.09604166   8.211761e-02
##  [87,] 0.09610411   8.397357e-02
##  [88,] 0.09688137   8.508498e-02
##  [89,] 0.09688137   8.474484e-02
##  [90,] 0.09740252   8.600927e-02
##  [91,] 0.09947487   8.601274e-02
##  [92,] 0.09963559   8.530374e-02
##  [93,] 0.09964437   8.336546e-02
##  [94,] 0.09972963   8.336838e-02
##  [95,] 0.10003125   8.469580e-02
##  [96,] 0.10040418   8.611032e-02
##  [97,] 0.10099629   8.833390e-02
##  [98,] 0.10162308   9.059248e-02
##  [99,] 0.10376536   9.276340e-02
## [100,] 0.10404326   9.273975e-02
## [101,] 0.10490591   9.606294e-02
## [102,] 0.10491544   9.792412e-02
## [103,] 0.10550474   9.862591e-02
## [104,] 0.10597287   9.983893e-02
## [105,] 0.10680005   1.019116e-01
## [106,] 0.10705606   1.051056e-01
## [107,] 0.10707007   1.094392e-01
## [108,] 0.10717859   1.095037e-01
## [109,] 0.10748953   1.090238e-01
## [110,] 0.10770330   1.087560e-01
## [111,] 0.10925200   1.086987e-01
## [112,] 0.10965856   1.126944e-01
## [113,] 0.11007270   1.135705e-01
## [114,] 0.11032792   1.123080e-01
## [115,] 0.11059950   1.114310e-01
## [116,] 0.11114068   1.126297e-01
## [117,] 0.11115417   1.195108e-01
## [118,] 0.11115417   1.195108e-01
## [119,] 0.11115755   1.223201e-01
## [120,] 0.11144954   1.227990e-01
## [121,] 0.11171504   1.224438e-01
## [122,] 0.11285943   1.223696e-01
## [123,] 0.11289818   1.224085e-01
## [124,] 0.11294357   1.256227e-01
## [125,] 0.11352973   1.280682e-01
## [126,] 0.11352973   1.299463e-01
## [127,] 0.11362328   1.344886e-01
## [128,] 0.11450000   1.396632e-01
## [129,] 0.11461239   1.398864e-01
## [130,] 0.11503912   1.389452e-01
## [131,] 0.11505325   1.388692e-01
## [132,] 0.11536464   1.369707e-01
## [133,] 0.11600539   1.374506e-01
## [134,] 0.11706942   1.419089e-01
## [135,] 0.11718042   1.430348e-01
## [136,] 0.11737653   1.445742e-01
## [137,] 0.11766053   1.450505e-01
## [138,] 0.11830152   1.469967e-01
## [139,] 0.11884864   1.501798e-01
## [140,] 0.11884969   1.501841e-01
## [141,] 0.11950418   1.509076e-01
## [142,] 0.11954183   1.507008e-01
## [143,] 0.11954183   1.528149e-01
## [144,] 0.11992081   1.518710e-01
## [145,] 0.11992081   1.518710e-01
## [146,] 0.12014991   1.499386e-01
## [147,] 0.12062442   1.546599e-01
## [148,] 0.12091733   1.637870e-01
## [149,] 0.12110326   1.686469e-01
## [150,] 0.12116621   1.688479e-01
## [151,] 0.12159770   1.700020e-01
## [152,] 0.12320816   1.755256e-01
## [153,] 0.12582230   1.772603e-01
## [154,] 0.12617845   1.772334e-01
## [155,] 0.12683552   1.796901e-01
## [156,] 0.12709839   1.795788e-01
## [157,] 0.12731457   1.805167e-01
## [158,] 0.12863126   1.865692e-01
## [159,] 0.12884487   1.926452e-01
## [160,] 0.12887591   1.930692e-01
## [161,] 0.12955308   2.011726e-01
## [162,] 0.13001538   2.029986e-01
## [163,] 0.13086252   2.048001e-01
## [164,] 0.13148764   2.082297e-01
## [165,] 0.13449535   2.088702e-01
## [166,] 0.13487123   2.131522e-01
## [167,] 0.13520817   2.197060e-01
## [168,] 0.13686581   2.215034e-01
## [169,] 0.13845216   2.224939e-01
## [170,] 0.13926952   2.232911e-01
## [171,] 0.14010799   2.232295e-01
## [172,] 0.14020075   2.258723e-01
## [173,] 0.14058449   2.320001e-01
## [174,] 0.14074889   2.326391e-01
## [175,] 0.14188464   2.349743e-01
## [176,] 0.14244385   2.348190e-01
## [177,] 0.14302447   2.336573e-01
## [178,] 0.14317821   2.322750e-01
## [179,] 0.14350000   2.299976e-01
## [180,] 0.14534442   2.318852e-01
## [181,] 0.14536936   2.306065e-01
## [182,] 0.14547251   2.308320e-01
## [183,] 0.14560220   2.320255e-01
## [184,] 0.14630875   2.377558e-01
## [185,] 0.14760505   2.415665e-01
## [186,] 0.14767871   2.417721e-01
## [187,] 0.14869095   2.437890e-01
## [188,] 0.14869095   2.437890e-01
## [189,] 0.14894966   2.448573e-01
## [190,] 0.14920121   2.452614e-01
## [191,] 0.14938290   2.464485e-01
## [192,] 0.14949582   2.440425e-01
## [193,] 0.14985410   2.483663e-01
## [194,] 0.15138444   2.496590e-01
## [195,] 0.15182226   2.500014e-01
## [196,] 0.15277516   2.519946e-01
## [197,] 0.15289621   2.520702e-01
## [198,] 0.15344706   2.507843e-01
## [199,] 0.15367498   2.481009e-01
## [200,] 0.15435349   2.473548e-01
## [201,] 0.15502016   2.474313e-01
## [202,] 0.15598477   2.453247e-01
## [203,] 0.15598477   2.453247e-01
## [204,] 0.15601602   2.460062e-01
## [205,] 0.15609372   2.434505e-01
## [206,] 0.15616017   2.398296e-01
## [207,] 0.15741982   2.371856e-01
## [208,] 0.15879310   2.362606e-01
## [209,] 0.15959402   2.337385e-01
## [210,] 0.16058954   2.335908e-01
## [211,] 0.16070159   2.458281e-01
## [212,] 0.16082288   2.488522e-01
## [213,] 0.16095419   2.518737e-01
## [214,] 0.16155494   2.537051e-01
## [215,] 0.16233915   2.577380e-01
## [216,] 0.16363145   2.631303e-01
## [217,] 0.16368873   2.696814e-01
## [218,] 0.16394283   2.724671e-01
## [219,] 0.16426275   2.761380e-01
## [220,] 0.16573774   2.829839e-01
## [221,] 0.16580184   2.824567e-01
## [222,] 0.16604292   2.822955e-01
## [223,] 0.16648123   2.912974e-01
## [224,] 0.16648123   2.912974e-01
## [225,] 0.16680003   2.905927e-01
## [226,] 0.16714066   2.910083e-01
## [227,] 0.16770510   3.101936e-01
## [228,] 0.16905990   3.113911e-01
## [229,] 0.16918924   3.087431e-01
## [230,] 0.17023807   3.080962e-01
## [231,] 0.17110596   3.081846e-01
## [232,] 0.17133374   3.039878e-01
## [233,] 0.17154008   3.038384e-01
## [234,] 0.17270206   3.044840e-01
## [235,] 0.17278961   3.048619e-01
## [236,] 0.17300000   3.016985e-01
## [237,] 0.17372680   3.020123e-01
## [238,] 0.17397126   3.034359e-01
## [239,] 0.17439968   3.010583e-01
## [240,] 0.17507141   3.083450e-01
## [241,] 0.17534537   3.081362e-01
## [242,] 0.17560182   3.058329e-01
## [243,] 0.17570501   2.986868e-01
## [244,] 0.17613915   2.941528e-01
## [245,] 0.18027756   2.976820e-01
## [246,] 0.18140080   2.976922e-01
## [247,] 0.18337121   2.978874e-01
## [248,] 0.18501689   3.032793e-01
## [249,] 0.18577944   3.043794e-01
## [250,] 0.18988483   3.089282e-01
## [251,] 0.19006578   3.087606e-01
## [252,] 0.19006578   3.227233e-01
## [253,] 0.19012890   3.235793e-01
## [254,] 0.19248441   3.194467e-01
## [255,] 0.19262918   3.187050e-01
## [256,] 0.19420929   3.177654e-01
## [257,] 0.19450964   3.145903e-01
## [258,] 0.19641092   3.146421e-01
## [259,] 0.19724604   3.156191e-01
## [260,] 0.20238824   3.308225e-01
## [261,] 0.20300000   3.289667e-01
## [262,] 0.20376518   3.267585e-01
## [263,] 0.20504938   3.293686e-01
## [264,] 0.20535092   3.294390e-01
## [265,] 0.20706038   3.373548e-01
## [266,] 0.20885641   3.357059e-01
## [267,] 0.20892582   3.333070e-01
## [268,] 0.20898624   3.286790e-01
## [269,] 0.20967177   3.244824e-01
## [270,] 0.21120192   3.099635e-01
## [271,] 0.21128417   3.062090e-01
## [272,] 0.21239645   3.026674e-01
## [273,] 0.21425744   3.016912e-01
## [274,] 0.21543038   3.035848e-01
## [275,] 0.21739423   3.026389e-01
## [276,] 0.21777339   2.935779e-01
## [277,] 0.22754175   2.947128e-01
## [278,] 0.22808113   2.996534e-01
## [279,] 0.22886950   3.066391e-01
## [280,] 0.23005434   3.178645e-01
## [281,] 0.23325362   3.161881e-01
## [282,] 0.23505797   3.131822e-01
## [283,] 0.23992134   3.073737e-01
## [284,] 0.24000833   2.968684e-01
## [285,] 0.24748737   2.936062e-01
## [286,] 0.25519649   2.908013e-01
## [287,] 0.25640008   2.741962e-01
## [288,] 0.25870302   2.649559e-01
## [289,] 0.26054030   2.593866e-01
## [290,] 0.26160275   2.561339e-01
## [291,] 0.26288020   2.505048e-01
## [292,] 0.26454725   2.394784e-01
## [293,] 0.26622782   2.338800e-01
## [294,] 0.26864289   2.240522e-01
## [295,] 0.27280213   2.156415e-01
## [296,] 0.27436108   2.101475e-01
## [297,] 0.28925292   1.903975e-01
## [298,] 0.29054303   1.761821e-01
## [299,] 0.29610007   1.748734e-01
## [300,] 0.29610007   1.748734e-01
## [301,] 0.29618786   1.708443e-01
## [302,] 0.29763904   1.686579e-01
## [303,] 0.29769951   1.643059e-01
## [304,] 0.31329738   1.593809e-01
## [305,] 0.31715769   1.527778e-01
## [306,] 0.31715769   1.527778e-01
## [307,] 0.33568177   1.537926e-01
## [308,] 0.33864768   1.492265e-01
## [309,] 0.33915925   1.506474e-01
## [310,] 0.34033219   1.557826e-01
## [311,] 0.37955369   1.521600e-01
## [312,] 0.38527555   1.506996e-01
## [313,] 0.39300922   1.481949e-01
## [314,] 0.39395431   1.385102e-01
## [315,] 0.41270449   1.338462e-01
## [316,] 0.41831687   1.250355e-01
## [317,] 0.43229880   1.185509e-01
## [318,] 0.45262595   1.087905e-01
## [319,] 0.51032857   9.506492e-02
## [320,] 0.52236099   8.787769e-02
## [321,] 0.52259832   8.774719e-02
## [322,] 0.55148640   8.408755e-02
## [323,] 0.55381315   8.410634e-02
## [324,] 0.57747381   1.024165e-01
## [325,] 0.60609178   1.001165e-01
## [326,] 0.63496535   9.949764e-02
## [327,] 0.90067044   5.853768e-02
ggplot(table.diff, aes(x=alpha.vals, diff.geom_corr))+geom_point()

area.acumulada <- cumsum(c(0, diff.geom_corr[-1] * diff(alpha.vals))) 
area.acumulada #analizar esto
##   [1] 0.000000e+00 1.799054e-07 8.589554e-07 1.012306e-06 1.355816e-06
##   [6] 3.099304e-06 4.954208e-06 6.474372e-06 1.004308e-05 1.053412e-05
##  [11] 1.342174e-05 1.491812e-05 1.635141e-05 2.365705e-05 2.695766e-05
##  [16] 2.725279e-05 2.820943e-05 3.213329e-05 3.874722e-05 4.385512e-05
##  [21] 4.562316e-05 5.141140e-05 5.239463e-05 5.239463e-05 6.276681e-05
##  [26] 6.276681e-05 6.287375e-05 8.233891e-05 1.057519e-04 1.142373e-04
##  [31] 1.147115e-04 1.241813e-04 1.386164e-04 1.573602e-04 1.583120e-04
##  [36] 1.778562e-04 1.816644e-04 1.899074e-04 2.186144e-04 2.249013e-04
##  [41] 2.313012e-04 2.647127e-04 2.647127e-04 2.659056e-04 2.715815e-04
##  [46] 2.811104e-04 2.815185e-04 2.815185e-04 3.046351e-04 3.155485e-04
##  [51] 3.170548e-04 3.356808e-04 3.547426e-04 3.547426e-04 3.877519e-04
##  [56] 4.092394e-04 4.165044e-04 4.199870e-04 4.306321e-04 4.524804e-04
##  [61] 5.355149e-04 5.686775e-04 5.804552e-04 5.932752e-04 5.949298e-04
##  [66] 6.019539e-04 6.190623e-04 6.427174e-04 6.585363e-04 6.779737e-04
##  [71] 6.837392e-04 6.837392e-04 6.837392e-04 7.007554e-04 7.049309e-04
##  [76] 7.837638e-04 7.882824e-04 7.951726e-04 8.569134e-04 8.575553e-04
##  [81] 8.656486e-04 8.786761e-04 8.964160e-04 8.964160e-04 9.359492e-04
##  [86] 9.375526e-04 9.427969e-04 1.008930e-03 1.008930e-03 1.053753e-03
##  [91] 1.232002e-03 1.245712e-03 1.246444e-03 1.253553e-03 1.279098e-03
##  [96] 1.311212e-03 1.363514e-03 1.420297e-03 1.619022e-03 1.644795e-03
## [101] 1.727663e-03 1.728597e-03 1.786717e-03 1.833455e-03 1.917753e-03
## [106] 1.944662e-03 1.946195e-03 1.958078e-03 1.991979e-03 2.015227e-03
## [111] 2.183569e-03 2.229386e-03 2.276420e-03 2.305083e-03 2.335346e-03
## [116] 2.396298e-03 2.397911e-03 2.397911e-03 2.398324e-03 2.434180e-03
## [121] 2.466689e-03 2.606727e-03 2.611471e-03 2.617173e-03 2.692242e-03
## [126] 2.692242e-03 2.704823e-03 2.827268e-03 2.842990e-03 2.902283e-03
## [131] 2.904244e-03 2.946896e-03 3.034967e-03 3.185963e-03 3.201839e-03
## [136] 3.230192e-03 3.271386e-03 3.365610e-03 3.447776e-03 3.447934e-03
## [141] 3.546702e-03 3.552376e-03 3.552376e-03 3.609931e-03 3.609931e-03
## [146] 3.644281e-03 3.717669e-03 3.765644e-03 3.797001e-03 3.807630e-03
## [151] 3.880984e-03 4.163661e-03 4.627044e-03 4.690165e-03 4.808236e-03
## [156] 4.855441e-03 4.894465e-03 5.140118e-03 5.181270e-03 5.187263e-03
## [161] 5.323490e-03 5.417338e-03 5.590832e-03 5.721000e-03 6.349222e-03
## [166] 6.429342e-03 6.503369e-03 6.870541e-03 7.223494e-03 7.406004e-03
## [171] 7.593176e-03 7.614127e-03 7.703156e-03 7.741400e-03 8.008272e-03
## [176] 8.139585e-03 8.275252e-03 8.310962e-03 8.384973e-03 8.812666e-03
## [181] 8.818417e-03 8.842227e-03 8.872319e-03 9.040305e-03 9.353448e-03
## [186] 9.371256e-03 9.618031e-03 9.618031e-03 9.681376e-03 9.743072e-03
## [191] 9.787849e-03 9.815407e-03 9.904391e-03 1.028646e-02 1.039591e-02
## [196] 1.063604e-02 1.066655e-02 1.080469e-02 1.086124e-02 1.102907e-02
## [201] 1.119403e-02 1.143067e-02 1.143067e-02 1.143836e-02 1.145728e-02
## [206] 1.147321e-02 1.177198e-02 1.209644e-02 1.228364e-02 1.251618e-02
## [211] 1.254373e-02 1.257391e-02 1.260699e-02 1.275940e-02 1.296152e-02
## [216] 1.330156e-02 1.331701e-02 1.338624e-02 1.347459e-02 1.389199e-02
## [221] 1.391009e-02 1.397815e-02 1.410583e-02 1.410583e-02 1.419847e-02
## [226] 1.429759e-02 1.447268e-02 1.489455e-02 1.493449e-02 1.525762e-02
## [231] 1.552510e-02 1.559434e-02 1.565703e-02 1.601083e-02 1.603753e-02
## [236] 1.610100e-02 1.632050e-02 1.639468e-02 1.652366e-02 1.673079e-02
## [241] 1.681520e-02 1.689363e-02 1.692445e-02 1.705216e-02 1.828409e-02
## [246] 1.861847e-02 1.920543e-02 1.970453e-02 1.993663e-02 2.120490e-02
## [251] 2.126077e-02 2.126077e-02 2.128120e-02 2.203366e-02 2.207980e-02
## [256] 2.258190e-02 2.267639e-02 2.327461e-02 2.353819e-02 2.523935e-02
## [261] 2.544060e-02 2.569063e-02 2.611360e-02 2.621294e-02 2.678963e-02
## [266] 2.739257e-02 2.741571e-02 2.743557e-02 2.765801e-02 2.813230e-02
## [271] 2.815748e-02 2.849413e-02 2.905558e-02 2.941167e-02 3.000600e-02
## [276] 3.011732e-02 3.299618e-02 3.315780e-02 3.339955e-02 3.377617e-02
## [281] 3.478774e-02 3.535283e-02 3.684770e-02 3.687353e-02 3.906942e-02
## [286] 4.131124e-02 4.164126e-02 4.225144e-02 4.272801e-02 4.300014e-02
## [291] 4.332014e-02 4.371937e-02 4.411242e-02 4.465352e-02 4.555042e-02
## [296] 4.587803e-02 4.871340e-02 4.894070e-02 4.991248e-02 4.991248e-02
## [301] 4.992748e-02 5.017223e-02 5.018216e-02 5.266817e-02 5.325794e-02
## [306] 5.325794e-02 5.610680e-02 5.654939e-02 5.662646e-02 5.680918e-02
## [311] 6.277713e-02 6.363941e-02 6.478550e-02 6.491641e-02 6.742605e-02
## [316] 6.812779e-02 6.978536e-02 7.199676e-02 7.748226e-02 7.853964e-02
## [321] 7.856046e-02 8.098959e-02 8.118529e-02 8.360853e-02 8.647366e-02
## [326] 8.934651e-02 1.049003e-01
data.acumulada <- data.frame(alpha = alpha.vals, area = area.acumulada)
head(data.acumulada)
##        alpha         area
## 1 0.02018044 0.000000e+00
## 2 0.02147091 1.799054e-07
## 3 0.02470324 8.589554e-07
## 4 0.02540177 1.012306e-06
## 5 0.02692582 1.355816e-06
## 6 0.03041381 3.099304e-06
p <- ggplot(data.acumulada, aes(x = alpha, y = area.acumulada)) +
  geom_line(size = 1, color = "blue") +
  labs(
    title = "Área Acumulada entre las Curvas",
    x = "Alpha",
    y = "Área Acumulada"
  ) +
  theme_minimal()

 ggplotly(p)
# Derivada.

tasa.cambio <- diff(area.acumulada) / diff(alpha.vals)
alpha.medios <- (alpha.vals[-1] + alpha.vals[-length(alpha.vals)])/2
data.derivada <- data.frame(alpha = alpha.medios, tasadecambio = tasa.cambio)

p.derivada <- ggplot(data.derivada, aes(x = alpha, y = tasa.cambio)) +
  geom_line(size = 1, color = "red") +
  labs(
    title = "Tasa de Cambio de la Función Acumulada",
    x = "Alpha",
    y = "Derivada (Tasa de Cambio)"
  ) +
  theme_minimal()

ggplotly(p.derivada)

5 Para la variable \(x_{3}\).

geom_indicesc <- indice1$results[[3]]$geom_indices 
geom_indicescmenosr <- indice2$results[[3]]$geom_indices
geom_indicescmasr <- indice3$results[[3]]$geom_indices

geom_indicescmenosr3 <- geom_indicescmenosr %>% group_by(alpha) %>% filter(geom_corr==max(geom_corr)) %>% ungroup() 

geom_indicescmasr3 <- geom_indicescmasr %>% group_by(alpha) %>% filter(geom_corr==max(geom_corr)) %>% ungroup() 

geom_indicesc$label <- "centros"
geom_indicescmenosr$label <- "centros menos rangos"
geom_indicescmasr$label <- "centros más rangos"

data_combined <- rbind(geom_indicesc,geom_indicescmenosr,geom_indicescmasr)
data_combined1 <- rbind(geom_indicescmenosr3, geom_indicescmasr3)
data_combined1 <- rbind(c(0,1),data_combined1)

ggplotly(ggplot(data_combined, aes(x = alpha, y = geom_corr, color = label)) +
  geom_step(size = 1) +
  labs(
    title = "Correlación geométrica con datos uniformes",
    x = "Alpha",
    y = "Geom_corr",
    color = "Curvas"
  ) +
  theme_minimal() +
  theme(legend.position = "bottom"))
alpha.vals <- sort(unique(c(geom_indicescmenosr3$alpha, geom_indicescmasr3$alpha)))
geom_corr.cmasr <- approx(geom_indicescmasr3$alpha, geom_indicescmasr3$geom_corr, xout = alpha.vals, rule = 2)$y
geom_corr.cmenosr <- approx(geom_indicescmenosr3$alpha, geom_indicescmenosr3$geom_corr, xout = alpha.vals, rule = 2)$y

diff.geom_corr <- geom_corr.cmasr - geom_corr.cmenosr

table.cmasr <- cbind(alpha.vals, geom_corr.cmasr)
table.cmenosr <- cbind(alpha.vals, geom_corr.cmenosr)
table.diff <- cbind(alpha.vals, diff.geom_corr)
table.diff
##        alpha.vals diff.geom_corr
##   [1,] 0.02385372  -1.137416e-05
##   [2,] 0.03003748   9.290018e-05
##   [3,] 0.03067572   1.073896e-04
##   [4,] 0.03297347   3.250368e-05
##   [5,] 0.04162031   2.319776e-06
##   [6,] 0.04215744   2.058668e-04
##   [7,] 0.04350000   5.651306e-04
##   [8,] 0.04509989   7.734447e-04
##   [9,] 0.04674666   9.189586e-04
##  [10,] 0.04743416   9.468998e-04
##  [11,] 0.04950000   9.512227e-04
##  [12,] 0.04952020   9.556540e-04
##  [13,] 0.05203124   1.656691e-03
##  [14,] 0.05246189   1.749880e-03
##  [15,] 0.05622277   1.909513e-03
##  [16,] 0.05749130   1.599704e-03
##  [17,] 0.05771698   2.163694e-03
##  [18,] 0.05771698   2.163694e-03
##  [19,] 0.05983519   2.451452e-03
##  [20,] 0.05993538   2.461262e-03
##  [21,] 0.06033448   2.601503e-03
##  [22,] 0.06039247   2.284531e-03
##  [23,] 0.06058259   2.250746e-03
##  [24,] 0.06222741   2.714737e-03
##  [25,] 0.06313478   2.802143e-03
##  [26,] 0.06313478   2.802143e-03
##  [27,] 0.06403124   3.514350e-03
##  [28,] 0.06403124   4.167198e-03
##  [29,] 0.06462198   4.632111e-03
##  [30,] 0.06519394   4.597367e-03
##  [31,] 0.06768309   5.057402e-03
##  [32,] 0.06964194   5.351024e-03
##  [33,] 0.07008745   6.223468e-03
##  [34,] 0.07156116   6.751861e-03
##  [35,] 0.07280110   6.702415e-03
##  [36,] 0.07323933   6.726773e-03
##  [37,] 0.07354590   7.757023e-03
##  [38,] 0.07354590   7.757023e-03
##  [39,] 0.07396114   8.749376e-03
##  [40,] 0.07500000   9.650222e-03
##  [41,] 0.07514819   1.075108e-02
##  [42,] 0.08009994   1.274172e-02
##  [43,] 0.08062258   1.518284e-02
##  [44,] 0.08077747   1.576390e-02
##  [45,] 0.08095678   1.681115e-02
##  [46,] 0.08158431   1.873112e-02
##  [47,] 0.08193900   2.014492e-02
##  [48,] 0.08193900   2.014492e-02
##  [49,] 0.08255453   2.245282e-02
##  [50,] 0.08325413   2.334184e-02
##  [51,] 0.08376157   2.205588e-02
##  [52,] 0.08440379   2.233274e-02
##  [53,] 0.08464780   2.156862e-02
##  [54,] 0.08516014   2.199710e-02
##  [55,] 0.08524817   2.322310e-02
##  [56,] 0.08558621   2.323504e-02
##  [57,] 0.08629745   2.258997e-02
##  [58,] 0.08692526   2.305905e-02
##  [59,] 0.08732125   2.545778e-02
##  [60,] 0.08732125   2.845000e-02
##  [61,] 0.08752285   3.031058e-02
##  [62,] 0.08793321   3.208088e-02
##  [63,] 0.08856636   3.219408e-02
##  [64,] 0.08903511   3.317782e-02
##  [65,] 0.08922023   3.340171e-02
##  [66,] 0.08949302   3.345290e-02
##  [67,] 0.08976219   3.360065e-02
##  [68,] 0.09055523   3.626338e-02
##  [69,] 0.09061043   3.617705e-02
##  [70,] 0.09082401   3.511247e-02
##  [71,] 0.09135234   3.258458e-02
##  [72,] 0.09154780   3.213179e-02
##  [73,] 0.09213577   3.116972e-02
##  [74,] 0.09213577   3.034390e-02
##  [75,] 0.09257564   3.066831e-02
##  [76,] 0.09266067   3.398238e-02
##  [77,] 0.09278470   3.586171e-02
##  [78,] 0.09363359   3.855438e-02
##  [79,] 0.09433981   4.273269e-02
##  [80,] 0.09581884   4.370493e-02
##  [81,] 0.09726767   4.906286e-02
##  [82,] 0.09774457   4.963366e-02
##  [83,] 0.09808670   4.850124e-02
##  [84,] 0.09886986   4.724548e-02
##  [85,] 0.09886986   4.724548e-02
##  [86,] 0.09970456   4.812448e-02
##  [87,] 0.10015114   5.235727e-02
##  [88,] 0.10062306   5.600309e-02
##  [89,] 0.10062306   5.600309e-02
##  [90,] 0.10065908   6.388795e-02
##  [91,] 0.10124228   6.425813e-02
##  [92,] 0.10127191   6.626276e-02
##  [93,] 0.10127191   6.626276e-02
##  [94,] 0.10178900   7.006216e-02
##  [95,] 0.10191173   7.332587e-02
##  [96,] 0.10198039   7.804248e-02
##  [97,] 0.10201103   7.818452e-02
##  [98,] 0.10307764   8.383710e-02
##  [99,] 0.10339367   8.626635e-02
## [100,] 0.10344564   8.730369e-02
## [101,] 0.10350000   8.830293e-02
## [102,] 0.10433240   8.814231e-02
## [103,] 0.10492378   8.888024e-02
## [104,] 0.10533399   9.030762e-02
## [105,] 0.10555094   8.935181e-02
## [106,] 0.10660793   9.314629e-02
## [107,] 0.10737900   9.729743e-02
## [108,] 0.10738366   9.729810e-02
## [109,] 0.11032792   9.777074e-02
## [110,] 0.11039022   9.588736e-02
## [111,] 0.11045361   9.591337e-02
## [112,] 0.11103603   9.898389e-02
## [113,] 0.11135641   1.023211e-01
## [114,] 0.11138335   1.075514e-01
## [115,] 0.11193860   1.094326e-01
## [116,] 0.11200893   1.088205e-01
## [117,] 0.11204463   1.100712e-01
## [118,] 0.11208144   1.117163e-01
## [119,] 0.11244554   1.148868e-01
## [120,] 0.11244554   1.148868e-01
## [121,] 0.11329607   1.154470e-01
## [122,] 0.11500109   1.150792e-01
## [123,] 0.11527793   1.145102e-01
## [124,] 0.11557357   1.146623e-01
## [125,] 0.11561682   1.203088e-01
## [126,] 0.11608294   1.208949e-01
## [127,] 0.11632390   1.183596e-01
## [128,] 0.11699252   1.188766e-01
## [129,] 0.11811964   1.190417e-01
## [130,] 0.11977479   1.215180e-01
## [131,] 0.11977479   1.258930e-01
## [132,] 0.12008435   1.296310e-01
## [133,] 0.12145884   1.318321e-01
## [134,] 0.12159770   1.324441e-01
## [135,] 0.12209013   1.341185e-01
## [136,] 0.12290749   1.371187e-01
## [137,] 0.12300000   1.459653e-01
## [138,] 0.12305385   1.460588e-01
## [139,] 0.12470064   1.504928e-01
## [140,] 0.12470064   1.536120e-01
## [141,] 0.12502500   1.541130e-01
## [142,] 0.12617845   1.559516e-01
## [143,] 0.12665011   1.623227e-01
## [144,] 0.12673200   1.664433e-01
## [145,] 0.12806248   1.706696e-01
## [146,] 0.12869441   1.816428e-01
## [147,] 0.12915591   1.852212e-01
## [148,] 0.12932131   1.875072e-01
## [149,] 0.12954150   1.898435e-01
## [150,] 0.12973531   1.924783e-01
## [151,] 0.13011629   1.976612e-01
## [152,] 0.13120690   2.075565e-01
## [153,] 0.13120690   2.125209e-01
## [154,] 0.13267347   2.141500e-01
## [155,] 0.13287682   2.166320e-01
## [156,] 0.13336416   2.222617e-01
## [157,] 0.13396268   2.242734e-01
## [158,] 0.13416408   2.252597e-01
## [159,] 0.13458176   2.276639e-01
## [160,] 0.13550738   2.298393e-01
## [161,] 0.13636715   2.340035e-01
## [162,] 0.13656500   2.389265e-01
## [163,] 0.13771438   2.448663e-01
## [164,] 0.13908990   2.520745e-01
## [165,] 0.14001428   2.592318e-01
## [166,] 0.14108951   2.649070e-01
## [167,] 0.14227087   2.713116e-01
## [168,] 0.14230249   2.720066e-01
## [169,] 0.14267533   2.760688e-01
## [170,] 0.14278393   2.784424e-01
## [171,] 0.14290644   2.805958e-01
## [172,] 0.14339107   2.802525e-01
## [173,] 0.14406943   2.817504e-01
## [174,] 0.14489997   2.831579e-01
## [175,] 0.14608302   2.864126e-01
## [176,] 0.14690218   2.913038e-01
## [177,] 0.14694302   2.892158e-01
## [178,] 0.14707566   2.874400e-01
## [179,] 0.14776332   2.910038e-01
## [180,] 0.14877920   2.935660e-01
## [181,] 0.14897063   2.941490e-01
## [182,] 0.15093459   2.980689e-01
## [183,] 0.15148927   2.987281e-01
## [184,] 0.15201069   2.982134e-01
## [185,] 0.15274243   2.985952e-01
## [186,] 0.15382539   2.983494e-01
## [187,] 0.15443445   2.985264e-01
## [188,] 0.15498710   2.959075e-01
## [189,] 0.15574418   2.936271e-01
## [190,] 0.15591344   2.972904e-01
## [191,] 0.15591344   2.972904e-01
## [192,] 0.15616978   2.978591e-01
## [193,] 0.15707960   3.035011e-01
## [194,] 0.15743967   3.110206e-01
## [195,] 0.15839902   3.225965e-01
## [196,] 0.15948041   3.276769e-01
## [197,] 0.15981317   3.306921e-01
## [198,] 0.16022562   3.330412e-01
## [199,] 0.16037768   3.330496e-01
## [200,] 0.16058409   3.369047e-01
## [201,] 0.16072103   3.404117e-01
## [202,] 0.16190198   3.470285e-01
## [203,] 0.16190198   3.470285e-01
## [204,] 0.16231836   3.506447e-01
## [205,] 0.16275442   3.505355e-01
## [206,] 0.16280049   3.506760e-01
## [207,] 0.16280740   3.527076e-01
## [208,] 0.16292943   3.633507e-01
## [209,] 0.16308663   3.634371e-01
## [210,] 0.16346559   3.596220e-01
## [211,] 0.16369255   3.555895e-01
## [212,] 0.16543579   3.591759e-01
## [213,] 0.16568042   3.609072e-01
## [214,] 0.16607303   3.632581e-01
## [215,] 0.16770510   3.640303e-01
## [216,] 0.16783623   3.638978e-01
## [217,] 0.16797991   3.706858e-01
## [218,] 0.16886089   3.676754e-01
## [219,] 0.17047287   3.667500e-01
## [220,] 0.17133009   3.663056e-01
## [221,] 0.17144168   3.676777e-01
## [222,] 0.17174181   3.671633e-01
## [223,] 0.17271436   3.802443e-01
## [224,] 0.17507141   3.901404e-01
## [225,] 0.17528548   3.906112e-01
## [226,] 0.17534537   3.900024e-01
## [227,] 0.17535393   3.900111e-01
## [228,] 0.17548219   4.001091e-01
## [229,] 0.17725970   3.998476e-01
## [230,] 0.17772451   3.993493e-01
## [231,] 0.17943035   4.001413e-01
## [232,] 0.17972479   3.988519e-01
## [233,] 0.17972479   3.996906e-01
## [234,] 0.18000000   3.995756e-01
## [235,] 0.18100345   4.035436e-01
## [236,] 0.18405434   4.017289e-01
## [237,] 0.18501689   3.973746e-01
## [238,] 0.18556401   3.931864e-01
## [239,] 0.18917981   3.999219e-01
## [240,] 0.19104973   3.998615e-01
## [241,] 0.19156526   4.043715e-01
## [242,] 0.19163768   4.129308e-01
## [243,] 0.19251234   4.240055e-01
## [244,] 0.19331904   4.272342e-01
## [245,] 0.19661193   4.454805e-01
## [246,] 0.19916137   4.475236e-01
## [247,] 0.19920090   4.458229e-01
## [248,] 0.20082393   4.438994e-01
## [249,] 0.20082393   4.372492e-01
## [250,] 0.20155644   4.321344e-01
## [251,] 0.20242529   4.314200e-01
## [252,] 0.20382836   4.363871e-01
## [253,] 0.20427677   4.379081e-01
## [254,] 0.20500976   4.445537e-01
## [255,] 0.20576747   4.561581e-01
## [256,] 0.20579662   4.561402e-01
## [257,] 0.20602245   4.491205e-01
## [258,] 0.20886599   4.468375e-01
## [259,] 0.20900060   4.465897e-01
## [260,] 0.21100948   4.471437e-01
## [261,] 0.21281506   4.432450e-01
## [262,] 0.21460953   4.386718e-01
## [263,] 0.21703917   4.381272e-01
## [264,] 0.21794724   4.377638e-01
## [265,] 0.21840330   4.314942e-01
## [266,] 0.21916945   4.235088e-01
## [267,] 0.21951310   4.222665e-01
## [268,] 0.21959110   4.221674e-01
## [269,] 0.21971800   4.150092e-01
## [270,] 0.22244157   4.131923e-01
## [271,] 0.22475765   4.156438e-01
## [272,] 0.22644039   4.129107e-01
## [273,] 0.22762963   3.945774e-01
## [274,] 0.23070761   3.915216e-01
## [275,] 0.23287819   3.903034e-01
## [276,] 0.23500053   3.901218e-01
## [277,] 0.23820999   3.993385e-01
## [278,] 0.23882054   3.988476e-01
## [279,] 0.24133017   3.859997e-01
## [280,] 0.24138610   3.769777e-01
## [281,] 0.24426471   3.719273e-01
## [282,] 0.24459150   3.635524e-01
## [283,] 0.25005000   3.580209e-01
## [284,] 0.25124689   3.562937e-01
## [285,] 0.25447446   3.506345e-01
## [286,] 0.25540948   3.434279e-01
## [287,] 0.25738881   3.337038e-01
## [288,] 0.27006666   3.324216e-01
## [289,] 0.27068478   3.318387e-01
## [290,] 0.27721833   3.354103e-01
## [291,] 0.28633198   3.399116e-01
## [292,] 0.28886156   3.435219e-01
## [293,] 0.29093126   3.443321e-01
## [294,] 0.29500042   3.459829e-01
## [295,] 0.29507668   3.459776e-01
## [296,] 0.30534448   3.405907e-01
## [297,] 0.30734996   3.615857e-01
## [298,] 0.30980801   3.632621e-01
## [299,] 0.31050000   3.600395e-01
## [300,] 0.31254000   3.569500e-01
## [301,] 0.31484123   3.469911e-01
## [302,] 0.32328045   3.387288e-01
## [303,] 0.32380550   3.296405e-01
## [304,] 0.32839801   3.247494e-01
## [305,] 0.32871758   2.997589e-01
## [306,] 0.32913371   2.892190e-01
## [307,] 0.33203915   2.904404e-01
## [308,] 0.34184938   3.018218e-01
## [309,] 0.34344723   3.018807e-01
## [310,] 0.35000143   2.932723e-01
## [311,] 0.35485243   2.837218e-01
## [312,] 0.35569685   2.832200e-01
## [313,] 0.36070244   2.818310e-01
## [314,] 0.36480851   2.785175e-01
## [315,] 0.37356024   2.761176e-01
## [316,] 0.37378604   2.651965e-01
## [317,] 0.38009505   2.639259e-01
## [318,] 0.40499414   2.424517e-01
## [319,] 0.40650000   2.435655e-01
## [320,] 0.41270449   2.380303e-01
## [321,] 0.42091240   2.348620e-01
## [322,] 0.46012607   2.178732e-01
## [323,] 0.47041498   2.008089e-01
## [324,] 0.61302039   1.929536e-01
## [325,] 0.72548260   1.702217e-01
## [326,] 0.73854181   1.650127e-01
## [327,] 0.83623696   1.464655e-01
ggplot(table.diff, aes(x=alpha.vals, diff.geom_corr))+geom_point()

area.acumulada <- cumsum(c(0, diff.geom_corr[-1] * diff(alpha.vals))) 
area.acumulada #analizar esto
##   [1] 0.000000e+00 5.744720e-07 6.430131e-07 7.176984e-07 7.377571e-07
##   [6] 8.483355e-07 1.607056e-06 2.844481e-06 4.357793e-06 5.008794e-06
##  [11] 6.973863e-06 6.993165e-06 1.115319e-05 1.190677e-05 1.908822e-05
##  [16] 2.111750e-05 2.160580e-05 2.160580e-05 2.679849e-05 2.704508e-05
##  [21] 2.808335e-05 2.821581e-05 2.864373e-05 3.310897e-05 3.565156e-05
##  [26] 3.565156e-05 3.880205e-05 3.880205e-05 4.153840e-05 4.416793e-05
##  [31] 5.675653e-05 6.723842e-05 7.001100e-05 7.996133e-05 8.827190e-05
##  [36] 9.121981e-05 9.359788e-05 9.359788e-05 9.723092e-05 1.072562e-04
##  [41] 1.088493e-04 1.719431e-04 1.798783e-04 1.823200e-04 1.853344e-04
##  [46] 1.970888e-04 2.042340e-04 2.042340e-04 2.180543e-04 2.343843e-04
##  [51] 2.455762e-04 2.599189e-04 2.651818e-04 2.764519e-04 2.784961e-04
##  [56] 2.863506e-04 3.024174e-04 3.168940e-04 3.269750e-04 3.269750e-04
##  [61] 3.330859e-04 3.462506e-04 3.666341e-04 3.821861e-04 3.883697e-04
##  [66] 3.974951e-04 4.065394e-04 4.352979e-04 4.372948e-04 4.447940e-04
##  [71] 4.620095e-04 4.682901e-04 4.866168e-04 4.866168e-04 5.001071e-04
##  [76] 5.029965e-04 5.074443e-04 5.401730e-04 5.703515e-04 6.349923e-04
##  [81] 7.060762e-04 7.297461e-04 7.463399e-04 7.833411e-04 7.833411e-04
##  [86] 8.235106e-04 8.468919e-04 8.733210e-04 8.733210e-04 8.756222e-04
##  [91] 9.130979e-04 9.150611e-04 9.150611e-04 9.512893e-04 9.602885e-04
##  [96] 9.656472e-04 9.680426e-04 1.057464e-03 1.084727e-03 1.089264e-03
## [101] 1.094064e-03 1.167434e-03 1.219996e-03 1.257041e-03 1.276426e-03
## [106] 1.374880e-03 1.449904e-03 1.450357e-03 1.738220e-03 1.744193e-03
## [111] 1.750273e-03 1.807924e-03 1.840705e-03 1.843602e-03 1.904365e-03
## [116] 1.912018e-03 1.915948e-03 1.920061e-03 1.961891e-03 1.961891e-03
## [121] 2.060082e-03 2.256294e-03 2.287994e-03 2.321894e-03 2.327098e-03
## [126] 2.383449e-03 2.411969e-03 2.491452e-03 2.625627e-03 2.826757e-03
## [131] 2.826757e-03 2.866885e-03 3.048087e-03 3.066478e-03 3.132523e-03
## [136] 3.244597e-03 3.258101e-03 3.265966e-03 3.513797e-03 3.513797e-03
## [141] 3.563784e-03 3.743666e-03 3.820228e-03 3.833858e-03 4.060931e-03
## [146] 4.175715e-03 4.261196e-03 4.292208e-03 4.334011e-03 4.371315e-03
## [151] 4.446621e-03 4.672983e-03 4.672983e-03 4.987050e-03 5.031102e-03
## [156] 5.139419e-03 5.273651e-03 5.319017e-03 5.414108e-03 5.626852e-03
## [161] 5.828042e-03 5.875314e-03 6.156757e-03 6.503491e-03 6.743121e-03
## [166] 7.027956e-03 7.348472e-03 7.357074e-03 7.460003e-03 7.490241e-03
## [171] 7.524617e-03 7.660437e-03 7.851564e-03 8.086737e-03 8.425580e-03
## [176] 8.664203e-03 8.676014e-03 8.714141e-03 8.914254e-03 9.212480e-03
## [181] 9.268791e-03 9.854184e-03 1.001988e-02 1.017538e-02 1.039387e-02
## [186] 1.071697e-02 1.089879e-02 1.106232e-02 1.128463e-02 1.133494e-02
## [191] 1.133494e-02 1.141130e-02 1.168743e-02 1.179942e-02 1.210890e-02
## [196] 1.246325e-02 1.257329e-02 1.271065e-02 1.276129e-02 1.283084e-02
## [201] 1.287745e-02 1.328727e-02 1.328727e-02 1.343328e-02 1.358613e-02
## [206] 1.360229e-02 1.360472e-02 1.364906e-02 1.370620e-02 1.384248e-02
## [211] 1.392318e-02 1.454931e-02 1.463760e-02 1.478022e-02 1.537434e-02
## [216] 1.542206e-02 1.547532e-02 1.579924e-02 1.639043e-02 1.670443e-02
## [221] 1.674546e-02 1.685566e-02 1.722547e-02 1.814505e-02 1.822867e-02
## [226] 1.825202e-02 1.825536e-02 1.830668e-02 1.901741e-02 1.920303e-02
## [231] 1.988561e-02 2.000305e-02 2.000305e-02 2.011302e-02 2.051795e-02
## [236] 2.174358e-02 2.212608e-02 2.234119e-02 2.378723e-02 2.453494e-02
## [241] 2.474341e-02 2.477331e-02 2.514417e-02 2.548882e-02 2.695574e-02
## [246] 2.809667e-02 2.811430e-02 2.883476e-02 2.883476e-02 2.915131e-02
## [251] 2.952615e-02 3.013842e-02 3.033479e-02 3.066064e-02 3.100627e-02
## [256] 3.101957e-02 3.112100e-02 3.239160e-02 3.245171e-02 3.334997e-02
## [261] 3.415029e-02 3.493747e-02 3.600196e-02 3.639948e-02 3.659627e-02
## [266] 3.692074e-02 3.706585e-02 3.709878e-02 3.715145e-02 3.827680e-02
## [271] 3.923947e-02 3.993429e-02 4.040354e-02 4.160863e-02 4.245581e-02
## [276] 4.328379e-02 4.456545e-02 4.480896e-02 4.577768e-02 4.579877e-02
## [281] 4.686940e-02 4.698820e-02 4.894246e-02 4.936891e-02 5.050060e-02
## [286] 5.082171e-02 5.148223e-02 5.569661e-02 5.590173e-02 5.809315e-02
## [291] 6.119099e-02 6.205995e-02 6.277262e-02 6.418048e-02 6.420686e-02
## [296] 6.770398e-02 6.842913e-02 6.932205e-02 6.957119e-02 7.029937e-02
## [301] 7.109787e-02 7.395648e-02 7.412956e-02 7.562097e-02 7.571677e-02
## [306] 7.583712e-02 7.668098e-02 7.964192e-02 8.012428e-02 8.204644e-02
## [311] 8.342278e-02 8.366194e-02 8.507267e-02 8.621628e-02 8.863278e-02
## [316] 8.869267e-02 9.035778e-02 9.639460e-02 9.676138e-02 9.823824e-02
## [321] 1.001660e-01 1.087096e-01 1.107757e-01 1.382919e-01 1.574354e-01
## [326] 1.595904e-01 1.738993e-01
data.acumulada <- data.frame(alpha = alpha.vals, area = area.acumulada)
head(data.acumulada)
##        alpha         area
## 1 0.02385372 0.000000e+00
## 2 0.03003748 5.744720e-07
## 3 0.03067572 6.430131e-07
## 4 0.03297347 7.176984e-07
## 5 0.04162031 7.377571e-07
## 6 0.04215744 8.483355e-07
p <- ggplot(data.acumulada, aes(x = alpha, y = area.acumulada)) +
  geom_line(size = 1, color = "blue") +
  labs(
    title = "Área Acumulada entre las Curvas",
    x = "Alpha",
    y = "Área Acumulada"
  ) +
  theme_minimal()

 ggplotly(p)
# Derivada.

tasa.cambio <- diff(area.acumulada) / diff(alpha.vals)
alpha.medios <- (alpha.vals[-1] + alpha.vals[-length(alpha.vals)])/2
data.derivada <- data.frame(alpha = alpha.medios, tasadecambio = tasa.cambio)

p.derivada <- ggplot(data.derivada, aes(x = alpha, y = tasa.cambio)) +
  geom_line(size = 1, color = "red") +
  labs(
    title = "Tasa de Cambio de la Función Acumulada",
    x = "Alpha",
    y = "Derivada (Tasa de Cambio)"
  ) +
  theme_minimal()

ggplotly(p.derivada)

6 Ejemplo 2. Modelo de círculos concéntricos con agujeros.

n=100

cita <- round(runif(n, 0, 2*pi),2)

r1 <- round(runif(n, 3,4),2)
x1.center <- r1*cos(cita)
y1.center <- r1*sin(cita)

r2 <- round(runif(n, 6,7),2)
x2.center <- r2*cos(cita)
y2.center <- r2*sin(cita)

r3 <- round(runif(n, 10,11),2)
x3.center <- r3*cos(cita)
y3.center <- r3*sin(cita)

x1.ranks <-  round(runif(n, 1, 2),2)
x2.ranks <-  round(runif(n, 1, 2),2)
x3.ranks <-  round(runif(n, 1, 2),2)
y1.ranks <-  round(runif(n, 1, 2),2)
y2.ranks <-  round(runif(n, 1, 2),2)
y3.ranks <-  round(runif(n, 1, 2),2)

x1.lower <- x1.center - x1.ranks
x1.upper <- x1.center + x1.ranks

x2.lower <- x2.center - x2.ranks
x2.upper <- x2.center + x2.ranks

x3.lower <- x3.center - x3.ranks
x3.upper <- x3.center + x3.ranks

y1.lower <- y1.center - y1.ranks
y2.lower <- y2.center - y2.ranks
y3.lower <- y3.center - y3.ranks
y1.upper <- y1.center + y1.ranks
y2.upper <- y2.center + y2.ranks
y3.upper <- y3.center + y3.ranks


tabla <- data.frame(x1.lower,x1.upper,x2.lower,x2.upper,x3.lower,x3.upper,y1.lower,y1.upper,y2.lower,y2.upper,y3.lower,y3.upper, x1.center, x1.ranks,x2.center,x2.ranks,x3.center,x3.ranks, y1.center, y1.ranks, y2.center, y2.ranks, y3.center, y3.ranks)


# Primero fijamos un espacio adecuado para graficar todo
plot(NULL, xlim = c(-12, 12), ylim = c(-12, 12), xlab = "x", ylab = "y", asp = 1,
     main = "Rectángulos simbólicos y sus centros")

# Dibujar los rectángulos del grupo 1
for (i in 1:n) {
  rect(x1.lower[i], y1.lower[i], x1.upper[i], y1.upper[i], border = "blue", col = rgb(0, 0, 1, 0.2))
  points(x1.center[i], y1.center[i], col = "blue", pch = 19, cex = 0.5)
}

# Rectángulos del grupo 2
for (i in 1:n) {
  rect(x2.lower[i], y2.lower[i], x2.upper[i], y2.upper[i], border = "forestgreen", col = rgb(0, 0.6, 0, 0.2))
  points(x2.center[i], y2.center[i], col = "forestgreen", pch = 19, cex = 0.5)
}

# Rectángulos del grupo 3
for (i in 1:n) {
  rect(x3.lower[i], y3.lower[i], x3.upper[i], y3.upper[i], border = "darkorange", col = rgb(1, 0.5, 0, 0.2))
  points(x3.center[i], y3.center[i], col = "darkorange", pch = 19, cex = 0.5)
}

legend("topright", legend = c("Grupo 1", "Grupo 2", "Grupo 3"),
       col = c("blue", "forestgreen", "darkorange"), pch = 19, bty = "n")

Xc <- c(x1.center, x2.center, x3.center)
Yc <- c(y1.center, y2.center, y3.center)
Xl <- c(x1.lower, x2.lower, x3.lower)
Yl <- c(y1.lower, y2.lower, y3.lower)
Xu <- c(x1.upper, x2.upper, x3.upper)
Yu <- c(y1.upper, y2.upper, y3.upper)

indice1 <- spatgeom(y=Yc, x=Xc) 
## Running with x and y
## Index estimation
## Estimating R2 Geom for variable = 1
plot_curve(indice1, type = "curve")

plot_curve(indice1, type = "deriv")

indice2 <- spatgeom(y=Yl, x=Xl) 
## Running with x and y
## Index estimation
## Estimating R2 Geom for variable = 1
plot_curve(indice2, type = "curve")

plot_curve(indice2, type = "deriv")

indice3 <- spatgeom(y=Yu, x=Xu) 
## Running with x and y
## Index estimation
## Estimating R2 Geom for variable = 1
plot_curve(indice3, type = "curve")

plot_curve(indice3, type = "deriv")

7 Para la variable \(x_{1}\).

geom_indicesc <- indice1$results[[1]]$geom_indices 
geom_indicescmenosr <- indice2$results[[1]]$geom_indices
geom_indicescmasr <- indice3$results[[1]]$geom_indices

geom_indicescmenosr1 <- geom_indicescmenosr %>% group_by(alpha) %>% filter(geom_corr==max(geom_corr)) %>% ungroup() 

geom_indicescmasr1 <- geom_indicescmasr %>% group_by(alpha) %>% filter(geom_corr==max(geom_corr)) %>% ungroup() 

geom_indicesc$label <- "centros"
geom_indicescmenosr$label <- "centros menos rangos"
geom_indicescmasr$label <- "centros más rangos"

data_combined <- rbind(geom_indicesc,geom_indicescmenosr,geom_indicescmasr)
data_combined1 <- rbind(geom_indicescmenosr1, geom_indicescmasr1)
data_combined1 <- rbind(c(0,1),data_combined1)

ggplotly(ggplot(data_combined, aes(x = alpha, y = geom_corr, color = label)) +
  geom_step(size = 1) +
  labs(
    title = "Correlación geométrica con datos uniformes",
    x = "Alpha",
    y = "Geom_corr",
    color = "Curvas"
  ) +
  theme_minimal() +
  theme(legend.position = "bottom"))
#Área acumulada entre las curvas: centros menos rangos y centros más rangos.

library(pracma)

alpha.vals <- sort(unique(c(geom_indicescmenosr1$alpha, geom_indicescmasr1$alpha)))

geom_corr.cmasr <- approx(geom_indicescmasr1$alpha, geom_indicescmasr1$geom_corr, xout = alpha.vals, rule = 2)$y

geom_corr.cmenosr <- approx(geom_indicescmenosr1$alpha, geom_indicescmenosr1$geom_corr, xout = alpha.vals, rule = 2)$y

diff.geom_corr <- geom_corr.cmasr - geom_corr.cmenosr

table.cmasr <- cbind(alpha.vals, geom_corr.cmasr)
table.cmenosr <- cbind(alpha.vals, geom_corr.cmenosr)
table.diff <- cbind(alpha.vals, diff.geom_corr)
table.diff
##         alpha.vals diff.geom_corr
##    [1,] 0.05751881  -2.851600e-06
##    [2,] 0.07104237   5.034950e-06
##    [3,] 0.07929438   7.526247e-06
##    [4,] 0.08378608   2.194501e-05
##    [5,] 0.08510697   2.372027e-05
##    [6,] 0.09448835   3.604006e-05
##    [7,] 0.10077100   6.265201e-05
##    [8,] 0.10448809   7.549548e-05
##    [9,] 0.10510004   4.892473e-05
##   [10,] 0.10649516   3.917267e-05
##   [11,] 0.10805732   3.290353e-05
##   [12,] 0.10856909   3.214808e-05
##   [13,] 0.11249304   4.123253e-05
##   [14,] 0.11453900   3.933572e-05
##   [15,] 0.12265966   4.131728e-05
##   [16,] 0.12447487   5.746840e-05
##   [17,] 0.12515969   7.608835e-05
##   [18,] 0.12601046   8.300276e-05
##   [19,] 0.12654086   6.456527e-05
##   [20,] 0.12673707   5.706473e-05
##   [21,] 0.13117561   4.395024e-05
##   [22,] 0.13122643   4.271595e-05
##   [23,] 0.13138331   4.195758e-05
##   [24,] 0.13196605  -1.467501e-06
##   [25,] 0.13347483   3.093752e-05
##   [26,] 0.13487940   6.590207e-05
##   [27,] 0.13666559   7.664236e-05
##   [28,] 0.13698212   2.814767e-05
##   [29,] 0.14108375   2.784344e-05
##   [30,] 0.14204654   2.241877e-05
##   [31,] 0.14513139   6.710959e-06
##   [32,] 0.14578325   4.390752e-06
##   [33,] 0.14819941  -4.446061e-05
##   [34,] 0.14967816  -4.700484e-05
##   [35,] 0.15084774  -4.429050e-05
##   [36,] 0.15111533  -1.507392e-05
##   [37,] 0.15588017  -2.607831e-05
##   [38,] 0.15810833  -2.318253e-05
##   [39,] 0.15819744  -8.852952e-05
##   [40,] 0.15857712  -9.523001e-05
##   [41,] 0.16026817  -1.297848e-04
##   [42,] 0.16369779  -1.412181e-04
##   [43,] 0.16662958  -1.457363e-04
##   [44,] 0.16700944  -1.449002e-04
##   [45,] 0.16758356  -1.046129e-04
##   [46,] 0.17358522  -1.055145e-04
##   [47,] 0.17700929  -1.635855e-04
##   [48,] 0.18032854  -1.671663e-04
##   [49,] 0.18355639  -1.250827e-04
##   [50,] 0.18692391  -6.579081e-05
##   [51,] 0.19082829  -6.216795e-05
##   [52,] 0.19407528  -8.923028e-05
##   [53,] 0.19527559  -9.201903e-05
##   [54,] 0.19850704  -9.297855e-05
##   [55,] 0.20353335  -1.051307e-04
##   [56,] 0.20474455  -7.256617e-05
##   [57,] 0.20558321  -5.714380e-05
##   [58,] 0.20698654  -1.273881e-04
##   [59,] 0.20766314  -2.073486e-04
##   [60,] 0.21022676  -1.763627e-04
##   [61,] 0.21143459  -1.859849e-04
##   [62,] 0.21220795  -2.205882e-04
##   [63,] 0.21247185  -1.422611e-04
##   [64,] 0.21257656  -1.395213e-04
##   [65,] 0.21306687  -1.363023e-04
##   [66,] 0.21322828  -1.447408e-04
##   [67,] 0.21421787  -3.008333e-04
##   [68,] 0.21959770  -2.693383e-04
##   [69,] 0.21963777  -2.693068e-04
##   [70,] 0.22160124  -2.623153e-04
##   [71,] 0.22222029  -3.322516e-04
##   [72,] 0.22315787  -3.279835e-04
##   [73,] 0.22368154  -2.350356e-04
##   [74,] 0.22451330  -9.401331e-05
##   [75,] 0.22535793  -8.600012e-05
##   [76,] 0.22736342  -6.571844e-05
##   [77,] 0.22785171  -5.695945e-05
##   [78,] 0.23035518  -7.106645e-05
##   [79,] 0.23099590   3.630833e-05
##   [80,] 0.23133272   6.773882e-05
##   [81,] 0.23158479   1.081890e-04
##   [82,] 0.23174957   9.848564e-05
##   [83,] 0.23278386   9.616329e-05
##   [84,] 0.23305077   8.199702e-05
##   [85,] 0.23366207   5.447681e-05
##   [86,] 0.23480390   4.144262e-05
##   [87,] 0.23538897   3.759687e-05
##   [88,] 0.23641187   1.378654e-05
##   [89,] 0.23678760  -8.729911e-05
##   [90,] 0.23685015  -1.502433e-04
##   [91,] 0.23685968  -2.076334e-04
##   [92,] 0.23943739  -1.976308e-04
##   [93,] 0.24101272  -1.116319e-04
##   [94,] 0.24108323   4.277189e-05
##   [95,] 0.24224670   1.238565e-04
##   [96,] 0.24238258   1.286826e-04
##   [97,] 0.24440618   7.348935e-05
##   [98,] 0.24534636   9.027253e-05
##   [99,] 0.24543109   8.012560e-05
##  [100,] 0.24602716   7.331216e-05
##  [101,] 0.24824937   8.563602e-05
##  [102,] 0.24860556   7.480575e-05
##  [103,] 0.25051496  -9.233808e-05
##  [104,] 0.25600747  -1.738584e-04
##  [105,] 0.25698784  -1.837543e-04
##  [106,] 0.25756298  -1.215985e-04
##  [107,] 0.25996174  -7.723253e-05
##  [108,] 0.26089015  -2.311284e-06
##  [109,] 0.26102029  -5.464256e-05
##  [110,] 0.26135688  -4.145180e-05
##  [111,] 0.26197420  -6.021246e-05
##  [112,] 0.26279392  -8.297598e-05
##  [113,] 0.26424322  -7.271791e-05
##  [114,] 0.26536118  -5.875311e-05
##  [115,] 0.26614556  -1.055355e-04
##  [116,] 0.26650648  -2.188283e-04
##  [117,] 0.26858423  -2.524450e-04
##  [118,] 0.26894438  -2.537658e-04
##  [119,] 0.27075674  -2.279795e-04
##  [120,] 0.27174739  -2.304471e-04
##  [121,] 0.27283522  -2.855846e-04
##  [122,] 0.27444322  -3.387329e-04
##  [123,] 0.27507291  -1.563222e-04
##  [124,] 0.27562571  -1.316054e-04
##  [125,] 0.27617730  -1.958313e-05
##  [126,] 0.27679246   3.873950e-05
##  [127,] 0.27744283   8.526421e-05
##  [128,] 0.27760892   4.939820e-05
##  [129,] 0.27799266   6.289061e-05
##  [130,] 0.27835671   2.968110e-05
##  [131,] 0.28070853  -1.355062e-05
##  [132,] 0.28123141   7.778902e-05
##  [133,] 0.28138803  -5.709444e-06
##  [134,] 0.28183948   1.521767e-05
##  [135,] 0.28196095   3.555579e-06
##  [136,] 0.28386319  -1.152022e-05
##  [137,] 0.28446594  -5.219258e-05
##  [138,] 0.28452431  -1.620840e-04
##  [139,] 0.28730373  -2.201410e-04
##  [140,] 0.28774953  -1.909496e-05
##  [141,] 0.28778195  -4.930680e-06
##  [142,] 0.28872323   5.075299e-05
##  [143,] 0.28893446   6.304883e-05
##  [144,] 0.28921269   8.450655e-06
##  [145,] 0.28961345  -1.022775e-04
##  [146,] 0.29093140  -1.503087e-04
##  [147,] 0.29163035   1.694568e-05
##  [148,] 0.29167288   1.565446e-05
##  [149,] 0.29169469  -3.627734e-05
##  [150,] 0.29215917  -8.890262e-05
##  [151,] 0.29600330  -1.032189e-04
##  [152,] 0.29674455  -1.423674e-04
##  [153,] 0.29730140  -1.048808e-05
##  [154,] 0.29744021  -8.302854e-06
##  [155,] 0.29832650  -1.808607e-04
##  [156,] 0.29952335  -1.762004e-04
##  [157,] 0.29959715  -3.473698e-04
##  [158,] 0.29987943  -3.428061e-04
##  [159,] 0.30105946  -2.480391e-04
##  [160,] 0.30280613  -2.714086e-04
##  [161,] 0.30304863  -2.859202e-04
##  [162,] 0.30603081  -3.068400e-04
##  [163,] 0.30643001  -4.418881e-04
##  [164,] 0.30932704  -4.259526e-04
##  [165,] 0.31011770  -5.612857e-04
##  [166,] 0.31036459  -5.784469e-04
##  [167,] 0.31079487  -5.892572e-04
##  [168,] 0.31179108  -5.905017e-04
##  [169,] 0.31360124  -5.492938e-04
##  [170,] 0.31412360  -5.631944e-04
##  [171,] 0.31429273  -4.355432e-04
##  [172,] 0.31444431  -3.066231e-04
##  [173,] 0.31728258  -3.107952e-04
##  [174,] 0.31732319  -4.653934e-04
##  [175,] 0.31783631  -5.236058e-04
##  [176,] 0.31871113  -5.781340e-04
##  [177,] 0.31953305  -5.377470e-04
##  [178,] 0.32231124  -4.788717e-04
##  [179,] 0.32472166  -3.693348e-04
##  [180,] 0.32584379  -3.303317e-04
##  [181,] 0.32709657  -2.982085e-04
##  [182,] 0.32715059  -2.969039e-04
##  [183,] 0.32950585  -1.580952e-04
##  [184,] 0.33020291  -1.086771e-04
##  [185,] 0.33042521   2.149014e-04
##  [186,] 0.33447663   4.210124e-04
##  [187,] 0.33628097   5.357294e-04
##  [188,] 0.33738744   4.470406e-04
##  [189,] 0.33791436   7.192453e-04
##  [190,] 0.33803452   7.395766e-04
##  [191,] 0.33865688   8.921169e-04
##  [192,] 0.33876732   1.125277e-03
##  [193,] 0.33956078   1.180033e-03
##  [194,] 0.34039404   1.199646e-03
##  [195,] 0.34111002   8.053825e-04
##  [196,] 0.34203455   5.661808e-04
##  [197,] 0.34215683   5.661112e-04
##  [198,] 0.34229746   1.168168e-03
##  [199,] 0.34419304   1.249671e-03
##  [200,] 0.34427179   1.241853e-03
##  [201,] 0.34500948   1.197256e-03
##  [202,] 0.34502553   1.199516e-03
##  [203,] 0.34714929   1.218719e-03
##  [204,] 0.35004225   1.189331e-03
##  [205,] 0.35086535   1.029870e-03
##  [206,] 0.35124282   1.162275e-03
##  [207,] 0.35160318   1.296987e-03
##  [208,] 0.35184809   1.354345e-03
##  [209,] 0.35188283   1.095812e-03
##  [210,] 0.35198978   8.856017e-04
##  [211,] 0.35203455   9.050098e-04
##  [212,] 0.35342684   1.052643e-03
##  [213,] 0.35445163   1.080263e-03
##  [214,] 0.35643644   1.139542e-03
##  [215,] 0.35675019   1.086970e-03
##  [216,] 0.35720956   1.014751e-03
##  [217,] 0.35765094   8.540180e-04
##  [218,] 0.35957042   1.034596e-03
##  [219,] 0.36012807   1.081820e-03
##  [220,] 0.36094842   1.219538e-03
##  [221,] 0.36199345   1.302021e-03
##  [222,] 0.36263783   1.450874e-03
##  [223,] 0.36298584   1.462196e-03
##  [224,] 0.36312219   1.462885e-03
##  [225,] 0.36339844   1.319648e-03
##  [226,] 0.36446361   1.573100e-03
##  [227,] 0.36513121   1.613607e-03
##  [228,] 0.36715135   1.653967e-03
##  [229,] 0.36800835   1.688514e-03
##  [230,] 0.36834180   1.279192e-03
##  [231,] 0.36986425   1.021136e-03
##  [232,] 0.36987364   9.432672e-04
##  [233,] 0.36999967   9.150602e-04
##  [234,] 0.37021891   9.061404e-04
##  [235,] 0.37045702   1.163316e-03
##  [236,] 0.37056665   1.292688e-03
##  [237,] 0.37153721   1.244116e-03
##  [238,] 0.37196381   1.216705e-03
##  [239,] 0.37238601   1.133693e-03
##  [240,] 0.37317619   8.427267e-04
##  [241,] 0.37367706   7.150981e-04
##  [242,] 0.37543026   7.455629e-04
##  [243,] 0.37553338   1.833570e-04
##  [244,] 0.37582009   1.884502e-04
##  [245,] 0.37698666   2.571199e-04
##  [246,] 0.37802288   3.490125e-04
##  [247,] 0.37879585   4.255290e-04
##  [248,] 0.37997065   8.285717e-04
##  [249,] 0.38040903   1.155404e-03
##  [250,] 0.38065633   1.372576e-03
##  [251,] 0.38111665   1.637583e-03
##  [252,] 0.38291659   1.679891e-03
##  [253,] 0.38375659   1.947927e-03
##  [254,] 0.38623637   1.929568e-03
##  [255,] 0.38632173   1.677844e-03
##  [256,] 0.38642587   1.093238e-03
##  [257,] 0.38851314   1.091705e-03
##  [258,] 0.38893645   1.363665e-03
##  [259,] 0.39021560   1.593063e-03
##  [260,] 0.39025562   1.597293e-03
##  [261,] 0.39116784   1.630020e-03
##  [262,] 0.39243110   1.561988e-03
##  [263,] 0.39341654   1.529523e-03
##  [264,] 0.39495728   1.644204e-03
##  [265,] 0.39545465   1.987293e-03
##  [266,] 0.39582465   2.285062e-03
##  [267,] 0.39598739   2.385814e-03
##  [268,] 0.39637954   2.474764e-03
##  [269,] 0.39677191   2.320871e-03
##  [270,] 0.39817053   2.370208e-03
##  [271,] 0.39924785   2.193408e-03
##  [272,] 0.39988241   2.274538e-03
##  [273,] 0.40003874   2.191841e-03
##  [274,] 0.40034053   2.288378e-03
##  [275,] 0.40118429   2.288079e-03
##  [276,] 0.40221488   2.164908e-03
##  [277,] 0.40268000   1.907818e-03
##  [278,] 0.40428999   1.886184e-03
##  [279,] 0.40505002   2.006134e-03
##  [280,] 0.40727052   2.063772e-03
##  [281,] 0.40778922   1.784345e-03
##  [282,] 0.40809221   1.727309e-03
##  [283,] 0.40827572   1.786057e-03
##  [284,] 0.40964635   1.978079e-03
##  [285,] 0.41012151   2.040787e-03
##  [286,] 0.41065429   1.941105e-03
##  [287,] 0.41126405   1.906063e-03
##  [288,] 0.41159682   1.934233e-03
##  [289,] 0.41324972   1.801680e-03
##  [290,] 0.41348742   1.318242e-03
##  [291,] 0.41428223   1.294213e-03
##  [292,] 0.41549273   1.390519e-03
##  [293,] 0.41587854   1.464148e-03
##  [294,] 0.41643290   1.150198e-03
##  [295,] 0.41709408   1.334924e-03
##  [296,] 0.41712251   1.344561e-03
##  [297,] 0.41767849   1.713530e-03
##  [298,] 0.41816268   2.191985e-03
##  [299,] 0.41881757   2.543157e-03
##  [300,] 0.41905832   2.491140e-03
##  [301,] 0.41923355   2.381170e-03
##  [302,] 0.41985709   1.667543e-03
##  [303,] 0.42035308   1.345319e-03
##  [304,] 0.42062964   7.847511e-04
##  [305,] 0.42073675   6.931233e-04
##  [306,] 0.42079408   3.981869e-04
##  [307,] 0.42185399   4.479583e-04
##  [308,] 0.42257198   3.931583e-04
##  [309,] 0.42349533  -9.381232e-05
##  [310,] 0.42377416  -1.993187e-04
##  [311,] 0.42496089  -2.758969e-04
##  [312,] 0.42499365  -7.215045e-05
##  [313,] 0.42533062   2.299031e-04
##  [314,] 0.42611812   2.974358e-04
##  [315,] 0.42726577   3.102388e-04
##  [316,] 0.42734848   3.138632e-04
##  [317,] 0.42863414  -3.928272e-05
##  [318,] 0.42863596  -3.908219e-05
##  [319,] 0.42982558   2.563447e-04
##  [320,] 0.43025787   6.369791e-04
##  [321,] 0.43082566   9.488843e-04
##  [322,] 0.43520011   1.415297e-03
##  [323,] 0.43523055   1.417628e-03
##  [324,] 0.43556010   1.245026e-03
##  [325,] 0.43574312   1.043383e-03
##  [326,] 0.43723763   1.031060e-03
##  [327,] 0.43791398   1.049398e-03
##  [328,] 0.43948531   9.573271e-04
##  [329,] 0.44063207   3.259228e-04
##  [330,] 0.44064576  -2.137102e-04
##  [331,] 0.44126946  -6.456508e-04
##  [332,] 0.44143711  -6.504554e-04
##  [333,] 0.44305340  -5.416033e-04
##  [334,] 0.44398705  -2.187961e-04
##  [335,] 0.44434544   3.393626e-04
##  [336,] 0.44449039   4.345864e-04
##  [337,] 0.44507970   7.484745e-04
##  [338,] 0.44796056   7.334564e-04
##  [339,] 0.44852603   4.868517e-04
##  [340,] 0.45125704   3.566135e-04
##  [341,] 0.45197986   2.073607e-04
##  [342,] 0.45207051   5.106735e-04
##  [343,] 0.45269919   6.337171e-04
##  [344,] 0.45271244   6.338605e-04
##  [345,] 0.45353117   3.174144e-04
##  [346,] 0.45428635   3.084507e-04
##  [347,] 0.45617390   1.088793e-04
##  [348,] 0.45659332   1.954059e-04
##  [349,] 0.45685581   5.674389e-04
##  [350,] 0.45710056   1.205189e-03
##  [351,] 0.45710619   1.204520e-03
##  [352,] 0.45896296   9.542074e-04
##  [353,] 0.46085636   6.078617e-04
##  [354,] 0.46096432   4.319101e-04
##  [355,] 0.46202073   8.312540e-05
##  [356,] 0.46246912  -4.680518e-04
##  [357,] 0.46599184  -7.024457e-04
##  [358,] 0.46628767  -5.659192e-04
##  [359,] 0.46686398  -2.532949e-04
##  [360,] 0.46961172   4.906816e-04
##  [361,] 0.47041010   5.096149e-04
##  [362,] 0.47192351   3.048746e-04
##  [363,] 0.47214026   8.443788e-04
##  [364,] 0.47346057   9.277188e-04
##  [365,] 0.47392687   8.147202e-04
##  [366,] 0.47417322   9.117721e-04
##  [367,] 0.47463064   9.942821e-04
##  [368,] 0.47483113   1.162643e-03
##  [369,] 0.47585940   1.253042e-03
##  [370,] 0.47681196   1.636260e-03
##  [371,] 0.47709600   1.730709e-03
##  [372,] 0.47866226   1.605032e-03
##  [373,] 0.47952859   1.590279e-03
##  [374,] 0.48036880   1.428427e-03
##  [375,] 0.48114617   1.285093e-03
##  [376,] 0.48249758   1.181026e-03
##  [377,] 0.48321258   5.557330e-04
##  [378,] 0.48346167   3.126690e-04
##  [379,] 0.48366749   3.072730e-04
##  [380,] 0.48469385   6.135527e-04
##  [381,] 0.48681600   5.218178e-04
##  [382,] 0.48700818  -7.171526e-05
##  [383,] 0.48701592  -7.162427e-05
##  [384,] 0.48930398   1.672547e-04
##  [385,] 0.48988064   2.810899e-04
##  [386,] 0.49085064   5.969137e-04
##  [387,] 0.49191529   9.142384e-04
##  [388,] 0.49325342   1.267293e-03
##  [389,] 0.49427745   1.677509e-03
##  [390,] 0.49469643   2.228454e-03
##  [391,] 0.49812277   2.398133e-03
##  [392,] 0.49849221   2.555974e-03
##  [393,] 0.49874653   2.647987e-03
##  [394,] 0.49938599   2.895537e-03
##  [395,] 0.50054864   3.394201e-03
##  [396,] 0.50079162   3.565241e-03
##  [397,] 0.50123171   3.494136e-03
##  [398,] 0.50133203   3.419961e-03
##  [399,] 0.50338855   3.688037e-03
##  [400,] 0.50373126   3.876133e-03
##  [401,] 0.50427930   3.908056e-03
##  [402,] 0.50441337   3.511031e-03
##  [403,] 0.50623035   3.498573e-03
##  [404,] 0.50626448   3.525569e-03
##  [405,] 0.50633672   2.822162e-03
##  [406,] 0.50635593   2.835814e-03
##  [407,] 0.50841511   2.702035e-03
##  [408,] 0.50858653   2.307069e-03
##  [409,] 0.50914424   2.297455e-03
##  [410,] 0.50918037   2.297989e-03
##  [411,] 0.51084372   2.287408e-03
##  [412,] 0.51149845   1.939639e-03
##  [413,] 0.51181675   1.933548e-03
##  [414,] 0.51203087   1.962163e-03
##  [415,] 0.51392546   1.856631e-03
##  [416,] 0.51449831   1.432853e-03
##  [417,] 0.51452407   1.435920e-03
##  [418,] 0.51548116   1.703672e-03
##  [419,] 0.51852035   1.805277e-03
##  [420,] 0.51871935   1.223172e-03
##  [421,] 0.51945093   7.391710e-04
##  [422,] 0.51953847   7.387873e-04
##  [423,] 0.52029468   8.501484e-04
##  [424,] 0.52285012   9.269376e-04
##  [425,] 0.52432788   8.098140e-04
##  [426,] 0.52440181   4.036629e-04
##  [427,] 0.52487972   3.562209e-04
##  [428,] 0.52613703   6.078749e-04
##  [429,] 0.52658389   1.119628e-03
##  [430,] 0.52961196   9.530996e-04
##  [431,] 0.52992849   5.530086e-04
##  [432,] 0.53044270   3.847729e-04
##  [433,] 0.53087874   3.017085e-04
##  [434,] 0.53112261   8.386045e-05
##  [435,] 0.53352913   3.042994e-04
##  [436,] 0.53379434   2.497094e-04
##  [437,] 0.53459538  -4.821929e-05
##  [438,] 0.53539986  -2.681627e-04
##  [439,] 0.53572468  -8.680004e-04
##  [440,] 0.53620509  -8.718505e-04
##  [441,] 0.53702161  -4.918295e-04
##  [442,] 0.53924773  -2.335035e-04
##  [443,] 0.53974255  -1.488283e-05
##  [444,] 0.54001359   3.341645e-04
##  [445,] 0.54012896   1.038725e-03
##  [446,] 0.54034782   1.536734e-03
##  [447,] 0.54166830   2.063222e-03
##  [448,] 0.54171012   1.834630e-03
##  [449,] 0.54206227   1.965332e-03
##  [450,] 0.54267653   2.806739e-03
##  [451,] 0.54282489   3.499964e-03
##  [452,] 0.54325337   4.030097e-03
##  [453,] 0.54431807   4.519522e-03
##  [454,] 0.54444211   4.511849e-03
##  [455,] 0.54860520   4.500034e-03
##  [456,] 0.55332669   4.498001e-03
##  [457,] 0.55354325   4.108727e-03
##  [458,] 0.55369192   3.932818e-03
##  [459,] 0.55376612   3.613226e-03
##  [460,] 0.55423212   3.914140e-03
##  [461,] 0.55522185   4.546821e-03
##  [462,] 0.55565061   4.655891e-03
##  [463,] 0.55680788   4.708204e-03
##  [464,] 0.55686956   4.511597e-03
##  [465,] 0.55971225   5.019762e-03
##  [466,] 0.56042739   5.484581e-03
##  [467,] 0.56075376   6.129726e-03
##  [468,] 0.56091178   6.608206e-03
##  [469,] 0.56270219   6.470680e-03
##  [470,] 0.56306072   6.348834e-03
##  [471,] 0.56391886   6.077366e-03
##  [472,] 0.56415697   6.040580e-03
##  [473,] 0.56480760   6.350741e-03
##  [474,] 0.56665985   6.255252e-03
##  [475,] 0.56747795   6.312395e-03
##  [476,] 0.56771354   6.786858e-03
##  [477,] 0.56973381   7.049333e-03
##  [478,] 0.57154166   7.240799e-03
##  [479,] 0.57157225   7.355184e-03
##  [480,] 0.57256370   7.554061e-03
##  [481,] 0.57346662   7.515060e-03
##  [482,] 0.57398014   7.546286e-03
##  [483,] 0.57570011   7.450044e-03
##  [484,] 0.57826115   7.712662e-03
##  [485,] 0.57870383   8.199776e-03
##  [486,] 0.57991241   8.475389e-03
##  [487,] 0.58013699   8.556711e-03
##  [488,] 0.58035474   8.582378e-03
##  [489,] 0.58123428   8.790275e-03
##  [490,] 0.58226444   8.610283e-03
##  [491,] 0.58228087   8.602752e-03
##  [492,] 0.58240537   8.328502e-03
##  [493,] 0.58342465   8.544282e-03
##  [494,] 0.58754265   9.177497e-03
##  [495,] 0.58773933   1.007204e-02
##  [496,] 0.59046113   1.028485e-02
##  [497,] 0.59099049   9.993407e-03
##  [498,] 0.59143415   9.465231e-03
##  [499,] 0.59152666   9.429560e-03
##  [500,] 0.59164181   9.599523e-03
##  [501,] 0.59177773   9.859762e-03
##  [502,] 0.59191698   1.055731e-02
##  [503,] 0.59369409   1.061048e-02
##  [504,] 0.59638965   1.065165e-02
##  [505,] 0.59776704   1.044612e-02
##  [506,] 0.60232807   9.528266e-03
##  [507,] 0.60321470   9.236051e-03
##  [508,] 0.60405551   8.343979e-03
##  [509,] 0.60591773   7.395946e-03
##  [510,] 0.60632806   7.267872e-03
##  [511,] 0.60873636   7.657370e-03
##  [512,] 0.61388787   7.731235e-03
##  [513,] 0.61644959   7.858543e-03
##  [514,] 0.61869076   8.281097e-03
##  [515,] 0.62062128   9.054613e-03
##  [516,] 0.62124051   9.287080e-03
##  [517,] 0.62258344   9.607146e-03
##  [518,] 0.62570658   9.353038e-03
##  [519,] 0.62731922   9.378161e-03
##  [520,] 0.62814055   9.774331e-03
##  [521,] 0.62944952   1.023709e-02
##  [522,] 0.63067413   1.086796e-02
##  [523,] 0.63325434   1.085563e-02
##  [524,] 0.63682565   1.097483e-02
##  [525,] 0.63745842   1.155710e-02
##  [526,] 0.63762530   1.157852e-02
##  [527,] 0.63789515   1.121980e-02
##  [528,] 0.64488346   1.231614e-02
##  [529,] 0.64541891   1.238362e-02
##  [530,] 0.64849433   1.262957e-02
##  [531,] 0.65024304   1.282937e-02
##  [532,] 0.65361363   1.332681e-02
##  [533,] 0.65652803   1.360300e-02
##  [534,] 0.65671242   1.409792e-02
##  [535,] 0.65839713   1.431394e-02
##  [536,] 0.65865727   1.463980e-02
##  [537,] 0.65894777   1.520195e-02
##  [538,] 0.65999340   1.611658e-02
##  [539,] 0.66207216   1.614239e-02
##  [540,] 0.66301483   1.566035e-02
##  [541,] 0.66392341   1.537381e-02
##  [542,] 0.66843326   1.548619e-02
##  [543,] 0.66974153   1.600198e-02
##  [544,] 0.66977659   1.600953e-02
##  [545,] 0.67346277   1.525023e-02
##  [546,] 0.67504405   1.437658e-02
##  [547,] 0.67697244   1.402628e-02
##  [548,] 0.67800009   1.487295e-02
##  [549,] 0.67874773   1.508351e-02
##  [550,] 0.67975652   1.534783e-02
##  [551,] 0.68058977   1.543389e-02
##  [552,] 0.68157586   1.537864e-02
##  [553,] 0.68651879   1.590170e-02
##  [554,] 0.68953542   1.608180e-02
##  [555,] 0.68972256   1.668785e-02
##  [556,] 0.68982077   1.681412e-02
##  [557,] 0.69027648   1.682626e-02
##  [558,] 0.69315202   1.633709e-02
##  [559,] 0.69463122   1.605028e-02
##  [560,] 0.69788704   1.591837e-02
##  [561,] 0.70125960   1.648044e-02
##  [562,] 0.70172734   1.653932e-02
##  [563,] 0.70364367   1.697412e-02
##  [564,] 0.70519713   1.676686e-02
##  [565,] 0.70682205   1.529912e-02
##  [566,] 0.71205252   1.514324e-02
##  [567,] 0.71215843   1.508209e-02
##  [568,] 0.71281495   1.562934e-02
##  [569,] 0.71284380   1.565630e-02
##  [570,] 0.71312817   1.601352e-02
##  [571,] 0.71330429   1.616676e-02
##  [572,] 0.71402805   1.695298e-02
##  [573,] 0.71439806   1.714013e-02
##  [574,] 0.71759202   1.727033e-02
##  [575,] 0.72110822   1.746483e-02
##  [576,] 0.72174084   1.702023e-02
##  [577,] 0.72531840   1.732165e-02
##  [578,] 0.72558240   1.734348e-02
##  [579,] 0.72843596   1.675086e-02
##  [580,] 0.72847723   1.786640e-02
##  [581,] 0.72978957   1.760820e-02
##  [582,] 0.73274479   1.773658e-02
##  [583,] 0.73446732   1.770635e-02
##  [584,] 0.73710825   1.743097e-02
##  [585,] 0.73839576   1.704272e-02
##  [586,] 0.73887174   1.695500e-02
##  [587,] 0.73997738   1.678560e-02
##  [588,] 0.74035267   1.650469e-02
##  [589,] 0.74388939   1.612108e-02
##  [590,] 0.74434355   1.549977e-02
##  [591,] 0.74526524   1.511854e-02
##  [592,] 0.74638456   1.443131e-02
##  [593,] 0.74920488   1.404553e-02
##  [594,] 0.75103771   1.353840e-02
##  [595,] 0.75248136   1.287662e-02
##  [596,] 0.75269058   1.278580e-02
##  [597,] 0.75380963   1.284853e-02
##  [598,] 0.75477421   1.256915e-02
##  [599,] 0.75492299   1.250309e-02
##  [600,] 0.75752112   1.208184e-02
##  [601,] 0.75772849   1.197953e-02
##  [602,] 0.75773209   1.333331e-02
##  [603,] 0.75855062   1.297870e-02
##  [604,] 0.76159961   1.310118e-02
##  [605,] 0.76170014   1.314035e-02
##  [606,] 0.76249472   1.352769e-02
##  [607,] 0.76282531   1.351718e-02
##  [608,] 0.76387040   1.344986e-02
##  [609,] 0.76535933   1.350933e-02
##  [610,] 0.76838270   1.408864e-02
##  [611,] 0.77035638   1.484306e-02
##  [612,] 0.77101014   1.550195e-02
##  [613,] 0.77433387   1.672887e-02
##  [614,] 0.77719555   1.679166e-02
##  [615,] 0.78001052   1.657770e-02
##  [616,] 0.78238957   1.668641e-02
##  [617,] 0.78251526   1.612985e-02
##  [618,] 0.78307521   1.585509e-02
##  [619,] 0.78482329   1.546610e-02
##  [620,] 0.78656244   1.416567e-02
##  [621,] 0.78677734   1.414874e-02
##  [622,] 0.78790815   1.408383e-02
##  [623,] 0.78961871   1.422599e-02
##  [624,] 0.79305089   1.440407e-02
##  [625,] 0.79337589   1.414422e-02
##  [626,] 0.79544441   1.307653e-02
##  [627,] 0.79549083   1.311813e-02
##  [628,] 0.79585822   1.363152e-02
##  [629,] 0.79601777   1.427842e-02
##  [630,] 0.79662059   1.588591e-02
##  [631,] 0.79942710   1.627237e-02
##  [632,] 0.80110588   1.756394e-02
##  [633,] 0.80492084   1.732513e-02
##  [634,] 0.80804659   1.704574e-02
##  [635,] 0.81295938   1.628978e-02
##  [636,] 0.81404054   1.575576e-02
##  [637,] 0.81563550   1.524024e-02
##  [638,] 0.81707489   1.499568e-02
##  [639,] 0.81758436   1.445235e-02
##  [640,] 0.82006788   1.443936e-02
##  [641,] 0.82136004   1.553210e-02
##  [642,] 0.82460304   1.562383e-02
##  [643,] 0.83003681   1.627317e-02
##  [644,] 0.83231631   1.629136e-02
##  [645,] 0.83242457   1.643218e-02
##  [646,] 0.83412527   1.852405e-02
##  [647,] 0.83414272   1.852639e-02
##  [648,] 0.83477353   1.780072e-02
##  [649,] 0.83918214   1.775220e-02
##  [650,] 0.83966384   1.824444e-02
##  [651,] 0.84048702   1.818261e-02
##  [652,] 0.84361332   1.804921e-02
##  [653,] 0.84563322   1.811497e-02
##  [654,] 0.84658376   1.812800e-02
##  [655,] 0.84808266   1.797240e-02
##  [656,] 0.84891589   1.794338e-02
##  [657,] 0.85016454   1.801766e-02
##  [658,] 0.85227986   1.771957e-02
##  [659,] 0.85467953   1.712963e-02
##  [660,] 0.85752927   1.689667e-02
##  [661,] 0.85755704   1.747854e-02
##  [662,] 0.86071890   1.732947e-02
##  [663,] 0.86426402   1.731786e-02
##  [664,] 0.86574847   1.854691e-02
##  [665,] 0.86603755   1.842966e-02
##  [666,] 0.86652594   1.786219e-02
##  [667,] 0.86828421   1.802091e-02
##  [668,] 0.87176763   1.786916e-02
##  [669,] 0.87268511   1.772887e-02
##  [670,] 0.87537879   1.727901e-02
##  [671,] 0.87839108   1.670848e-02
##  [672,] 0.87857773   1.770046e-02
##  [673,] 0.87961922   1.818689e-02
##  [674,] 0.88082411   1.864079e-02
##  [675,] 0.88400581   1.788464e-02
##  [676,] 0.88637360   1.670465e-02
##  [677,] 0.88884294   1.603196e-02
##  [678,] 0.89157219   1.610252e-02
##  [679,] 0.89397373   1.605992e-02
##  [680,] 0.89900194   1.617076e-02
##  [681,] 0.89910337   1.618887e-02
##  [682,] 0.90403026   1.712947e-02
##  [683,] 0.90832238   1.720983e-02
##  [684,] 0.91381621   1.732787e-02
##  [685,] 0.91499228   1.809391e-02
##  [686,] 0.91677675   1.973681e-02
##  [687,] 0.91946739   2.035789e-02
##  [688,] 0.92189788   2.087875e-02
##  [689,] 0.92487978   2.250612e-02
##  [690,] 0.92595646   2.267624e-02
##  [691,] 0.92704861   2.303478e-02
##  [692,] 0.93115407   2.375170e-02
##  [693,] 0.93215705   2.371740e-02
##  [694,] 0.93574316   2.307861e-02
##  [695,] 0.94091613   2.321526e-02
##  [696,] 0.95431641   2.266789e-02
##  [697,] 0.95698577   2.582779e-02
##  [698,] 0.96348714   2.553093e-02
##  [699,] 0.96447278   2.567200e-02
##  [700,] 0.96809006   2.502519e-02
##  [701,] 0.96969415   2.449810e-02
##  [702,] 0.97911430   2.517425e-02
##  [703,] 0.98459634   2.629862e-02
##  [704,] 0.98912667   2.670741e-02
##  [705,] 0.98930080   2.664217e-02
##  [706,] 0.99013299   2.657696e-02
##  [707,] 0.99230661   2.650882e-02
##  [708,] 0.99240310   2.652673e-02
##  [709,] 0.99299208   2.781676e-02
##  [710,] 0.99480770   2.793783e-02
##  [711,] 0.99788722   2.777800e-02
##  [712,] 0.99822481   2.687328e-02
##  [713,] 0.99970169   2.669037e-02
##  [714,] 1.00203290   2.646186e-02
##  [715,] 1.00240957   2.543695e-02
##  [716,] 1.00263314   2.485620e-02
##  [717,] 1.00837456   2.511151e-02
##  [718,] 1.00972653   2.505236e-02
##  [719,] 1.01087538   2.515570e-02
##  [720,] 1.01365516   2.567866e-02
##  [721,] 1.01558554   2.935498e-02
##  [722,] 1.01562520   2.941411e-02
##  [723,] 1.01841579   2.807249e-02
##  [724,] 1.01925554   2.719632e-02
##  [725,] 1.02360138   2.515407e-02
##  [726,] 1.02636805   2.323863e-02
##  [727,] 1.02907606   2.084480e-02
##  [728,] 1.03115287   1.868689e-02
##  [729,] 1.03331600   1.860609e-02
##  [730,] 1.03529013   2.075726e-02
##  [731,] 1.03574385   2.202782e-02
##  [732,] 1.03646976   2.249042e-02
##  [733,] 1.03705129   2.284332e-02
##  [734,] 1.03909267   2.373463e-02
##  [735,] 1.03963803   2.423311e-02
##  [736,] 1.04173551   2.443802e-02
##  [737,] 1.04452094   2.361778e-02
##  [738,] 1.04979848   2.441722e-02
##  [739,] 1.05215537   2.540920e-02
##  [740,] 1.05817991   2.514246e-02
##  [741,] 1.05939579   2.508981e-02
##  [742,] 1.06598537   2.625721e-02
##  [743,] 1.06904433   2.683063e-02
##  [744,] 1.07531809   2.691342e-02
##  [745,] 1.07541128   2.887833e-02
##  [746,] 1.07695366   3.063344e-02
##  [747,] 1.08039561   3.109739e-02
##  [748,] 1.08568603   3.207220e-02
##  [749,] 1.08605661   3.212448e-02
##  [750,] 1.09063086   3.176654e-02
##  [751,] 1.09143558   3.169686e-02
##  [752,] 1.09435479   3.260336e-02
##  [753,] 1.09493308   3.285232e-02
##  [754,] 1.09494477   3.396994e-02
##  [755,] 1.09793089   3.408263e-02
##  [756,] 1.09836590   3.236584e-02
##  [757,] 1.10003450   3.221959e-02
##  [758,] 1.10227322   3.174699e-02
##  [759,] 1.10305146   3.040859e-02
##  [760,] 1.10445821   3.039769e-02
##  [761,] 1.10487766   3.132617e-02
##  [762,] 1.11158358   3.080836e-02
##  [763,] 1.11220590   2.957615e-02
##  [764,] 1.11357776   2.947798e-02
##  [765,] 1.11368647   3.219201e-02
##  [766,] 1.11523000   3.570901e-02
##  [767,] 1.11639979   3.719632e-02
##  [768,] 1.12509956   3.672194e-02
##  [769,] 1.12702050   3.636228e-02
##  [770,] 1.13021547   3.752707e-02
##  [771,] 1.13640380   3.618282e-02
##  [772,] 1.13799881   3.614841e-02
##  [773,] 1.13934536   3.706693e-02
##  [774,] 1.14474777   3.710490e-02
##  [775,] 1.14574973   3.775299e-02
##  [776,] 1.14584485   3.975633e-02
##  [777,] 1.14652577   4.005303e-02
##  [778,] 1.14826943   4.090287e-02
##  [779,] 1.15233529   4.231691e-02
##  [780,] 1.15743334   4.281308e-02
##  [781,] 1.15771368   4.514399e-02
##  [782,] 1.15851653   4.541119e-02
##  [783,] 1.16028204   4.400518e-02
##  [784,] 1.16129367   4.242244e-02
##  [785,] 1.16447394   4.243667e-02
##  [786,] 1.16867844   4.416907e-02
##  [787,] 1.17148478   4.478957e-02
##  [788,] 1.17254485   4.512665e-02
##  [789,] 1.17433974   4.580051e-02
##  [790,] 1.17525565   4.561716e-02
##  [791,] 1.17621990   4.447476e-02
##  [792,] 1.18309138   4.422896e-02
##  [793,] 1.18336963   4.219393e-02
##  [794,] 1.18812823   4.084951e-02
##  [795,] 1.18863135   3.988950e-02
##  [796,] 1.18968846   3.823016e-02
##  [797,] 1.19066119   3.610031e-02
##  [798,] 1.19302436   3.455538e-02
##  [799,] 1.19397245   3.567676e-02
##  [800,] 1.19409967   3.589401e-02
##  [801,] 1.19990475   3.846078e-02
##  [802,] 1.20186348   3.848229e-02
##  [803,] 1.20357127   3.937590e-02
##  [804,] 1.20642437   4.093759e-02
##  [805,] 1.20847527   4.319430e-02
##  [806,] 1.21102770   4.515524e-02
##  [807,] 1.21194087   4.503054e-02
##  [808,] 1.21712493   4.444425e-02
##  [809,] 1.21835625   4.297217e-02
##  [810,] 1.21896608   4.259180e-02
##  [811,] 1.22244431   4.182921e-02
##  [812,] 1.23238362   4.038298e-02
##  [813,] 1.23740302   4.034107e-02
##  [814,] 1.24288227   4.088215e-02
##  [815,] 1.24379796   4.073451e-02
##  [816,] 1.24402278   4.241810e-02
##  [817,] 1.24699203   4.185205e-02
##  [818,] 1.25076485   3.905063e-02
##  [819,] 1.25713441   3.812228e-02
##  [820,] 1.25778227   3.896360e-02
##  [821,] 1.25857427   3.705105e-02
##  [822,] 1.25917220   3.409580e-02
##  [823,] 1.25945690   3.400156e-02
##  [824,] 1.25956413   3.414521e-02
##  [825,] 1.26381068   3.305127e-02
##  [826,] 1.26592059   3.418457e-02
##  [827,] 1.26700865   3.408475e-02
##  [828,] 1.26801377   3.467341e-02
##  [829,] 1.27663262   3.747587e-02
##  [830,] 1.27810765   4.230532e-02
##  [831,] 1.28075322   4.285396e-02
##  [832,] 1.28097890   4.038104e-02
##  [833,] 1.28113021   3.777180e-02
##  [834,] 1.28788168   4.075843e-02
##  [835,] 1.29050875   4.546931e-02
##  [836,] 1.29522312   4.899119e-02
##  [837,] 1.29604352   4.999749e-02
##  [838,] 1.29753454   5.042238e-02
##  [839,] 1.29909406   4.997819e-02
##  [840,] 1.29914070   4.993418e-02
##  [841,] 1.30042700   4.941140e-02
##  [842,] 1.30292915   4.871204e-02
##  [843,] 1.30311122   4.882613e-02
##  [844,] 1.30394296   4.571735e-02
##  [845,] 1.30508990   3.848090e-02
##  [846,] 1.30561875   3.916314e-02
##  [847,] 1.32618424   3.518470e-02
##  [848,] 1.34091466   2.859810e-02
##  [849,] 1.34115829   2.840349e-02
##  [850,] 1.34411796   2.619080e-02
##  [851,] 1.34924987   2.618205e-02
##  [852,] 1.35229338   2.841531e-02
##  [853,] 1.35529063   2.855327e-02
##  [854,] 1.36015589   2.247033e-02
##  [855,] 1.36969456   2.107829e-02
##  [856,] 1.37074103   1.882416e-02
##  [857,] 1.37552425   1.723560e-02
##  [858,] 1.37593576   1.707348e-02
##  [859,] 1.38166161   1.691628e-02
##  [860,] 1.38298445   1.774954e-02
##  [861,] 1.38308015   1.775040e-02
##  [862,] 1.39606067   1.537378e-02
##  [863,] 1.39871125   1.503164e-02
##  [864,] 1.40406634   9.544499e-03
##  [865,] 1.40469415   8.796723e-03
##  [866,] 1.40626931   9.434542e-03
##  [867,] 1.40649278   9.186743e-03
##  [868,] 1.40764050   6.956479e-03
##  [869,] 1.40910505   4.385115e-03
##  [870,] 1.41052054   3.604088e-03
##  [871,] 1.41593318   3.869833e-03
##  [872,] 1.42168853   4.051479e-03
##  [873,] 1.42290006   7.021699e-04
##  [874,] 1.42290960   6.788699e-04
##  [875,] 1.42335711  -4.396334e-03
##  [876,] 1.42344146  -8.631717e-03
##  [877,] 1.42482943  -8.213421e-03
##  [878,] 1.42905505  -8.186921e-03
##  [879,] 1.43025336  -6.606331e-03
##  [880,] 1.44478437  -5.502131e-03
##  [881,] 1.44621897  -1.117242e-02
##  [882,] 1.44630419  -1.114991e-02
##  [883,] 1.45245499  -8.554309e-03
##  [884,] 1.45736454  -8.278428e-03
##  [885,] 1.46651469  -8.022198e-03
##  [886,] 1.46929828  -3.909455e-03
##  [887,] 1.47093752  -3.929694e-03
##  [888,] 1.47109308   2.330336e-03
##  [889,] 1.48235674   3.586873e-03
##  [890,] 1.48402708   4.227329e-03
##  [891,] 1.49213781   7.080646e-03
##  [892,] 1.49230964   7.433207e-03
##  [893,] 1.49434495   8.723057e-03
##  [894,] 1.49832059   8.958353e-03
##  [895,] 1.50056220   6.240517e-03
##  [896,] 1.50477777   1.952572e-03
##  [897,] 1.50546568   2.009380e-03
##  [898,] 1.51039499   2.939739e-03
##  [899,] 1.52388023   5.372723e-03
##  [900,] 1.53823836   1.301468e-02
##  [901,] 1.54933222   1.975483e-02
##  [902,] 1.55083300   2.341174e-02
##  [903,] 1.55152637   2.371204e-02
##  [904,] 1.55752086   2.421479e-02
##  [905,] 1.55812501   2.832341e-02
##  [906,] 1.55912565   2.845736e-02
##  [907,] 1.56629234   3.070133e-02
##  [908,] 1.56855785   3.067059e-02
##  [909,] 1.57700845   2.704741e-02
##  [910,] 1.58277542   2.494473e-02
##  [911,] 1.58701183   2.296680e-02
##  [912,] 1.59242759   2.196138e-02
##  [913,] 1.59253405   2.250377e-02
##  [914,] 1.59262256   2.282134e-02
##  [915,] 1.59318654   2.419940e-02
##  [916,] 1.59319411   2.418078e-02
##  [917,] 1.59795765   2.607014e-02
##  [918,] 1.60507563   2.757753e-02
##  [919,] 1.61181283   2.919500e-02
##  [920,] 1.62515935   3.529778e-02
##  [921,] 1.62699947   4.676606e-02
##  [922,] 1.62901926   4.882043e-02
##  [923,] 1.63157281   4.944939e-02
##  [924,] 1.63318806   4.933980e-02
##  [925,] 1.64680239   4.562208e-02
##  [926,] 1.64764061   4.155166e-02
##  [927,] 1.65444836   3.064207e-02
##  [928,] 1.65464540   2.604847e-02
##  [929,] 1.65511661   1.854638e-02
##  [930,] 1.65518197   1.752172e-02
##  [931,] 1.65999337   1.723936e-02
##  [932,] 1.66089318   2.140497e-02
##  [933,] 1.66219009   2.154402e-02
##  [934,] 1.66452763   2.094941e-02
##  [935,] 1.66830409   2.077840e-02
##  [936,] 1.67586022   2.306131e-02
##  [937,] 1.67849131   2.973328e-02
##  [938,] 1.68480298   3.073232e-02
##  [939,] 1.68789184   3.328964e-02
##  [940,] 1.68857875   3.753532e-02
##  [941,] 1.69492389   3.628670e-02
##  [942,] 1.69574508   3.571392e-02
##  [943,] 1.69728807   3.567517e-02
##  [944,] 1.69841966   3.266165e-02
##  [945,] 1.69938584   3.127258e-02
##  [946,] 1.70092069   2.800731e-02
##  [947,] 1.70362947   2.445905e-02
##  [948,] 1.70526627   2.376969e-02
##  [949,] 1.71053572   2.147418e-02
##  [950,] 1.71167708   2.097701e-02
##  [951,] 1.71285191   1.780310e-02
##  [952,] 1.71729830   1.700441e-02
##  [953,] 1.72041865   1.973275e-02
##  [954,] 1.72206926   2.004738e-02
##  [955,] 1.72394186   1.872988e-02
##  [956,] 1.72482214   2.435796e-02
##  [957,] 1.72570757   2.608967e-02
##  [958,] 1.72686874   2.905614e-02
##  [959,] 1.72717463   2.886152e-02
##  [960,] 1.72883872   1.892292e-02
##  [961,] 1.73666572   1.702462e-02
##  [962,] 1.73753776   9.991165e-03
##  [963,] 1.73955077   9.145899e-03
##  [964,] 1.74088822   1.661377e-02
##  [965,] 1.74192052   1.578284e-02
##  [966,] 1.76066515   1.637964e-02
##  [967,] 1.76389493   1.618956e-02
##  [968,] 1.78221547   2.119736e-02
##  [969,] 1.78306059   2.125149e-02
##  [970,] 1.79045339   2.177670e-02
##  [971,] 1.79150932   2.240476e-02
##  [972,] 1.79575221   2.240368e-02
##  [973,] 1.80359767   2.163356e-02
##  [974,] 1.80447919   2.210063e-02
##  [975,] 1.80713972   2.592121e-02
##  [976,] 1.81343752   2.474480e-02
##  [977,] 1.81960749   2.410717e-02
##  [978,] 1.82439049   1.902577e-02
##  [979,] 1.83148334   1.454245e-02
##  [980,] 1.83746723   1.095703e-02
##  [981,] 1.84659135   4.590202e-03
##  [982,] 1.84792919   9.072712e-04
##  [983,] 1.85787915  -2.883439e-03
##  [984,] 1.85917635  -4.198879e-03
##  [985,] 1.86561271  -8.550777e-03
##  [986,] 1.86697461  -7.885852e-03
##  [987,] 1.87037205  -4.595588e-03
##  [988,] 1.87058172  -4.514267e-03
##  [989,] 1.87341657  -7.326320e-03
##  [990,] 1.87795427  -1.204252e-03
##  [991,] 1.88029143   2.634428e-03
##  [992,] 1.88231242   1.382983e-02
##  [993,] 1.89186369   2.045369e-02
##  [994,] 1.89722737   2.281530e-02
##  [995,] 1.90068015   2.264712e-02
##  [996,] 1.90221029   2.153085e-02
##  [997,] 1.90436500   1.338463e-02
##  [998,] 1.92199518   1.563696e-02
##  [999,] 1.92499091   1.384530e-02
## [1000,] 1.93331660   1.273308e-02
## [1001,] 1.93596691   1.276858e-02
## [1002,] 1.93873088   1.172057e-02
## [1003,] 1.94373447   6.285780e-03
## [1004,] 1.95756569   4.476961e-03
## [1005,] 1.95825412   1.408258e-02
## [1006,] 1.95943401   2.239050e-02
## [1007,] 1.97264360   1.796461e-02
## [1008,] 1.98070274   1.553610e-02
## [1009,] 1.98387380   7.990131e-03
## [1010,] 1.98586054   4.549919e-03
## [1011,] 1.98702561   4.392195e-03
## [1012,] 1.99991302   7.854182e-03
## [1013,] 1.99994884   7.749381e-03
## [1014,] 2.00244762  -5.869971e-04
## [1015,] 2.00379857  -6.927762e-03
## [1016,] 2.00490300  -9.526290e-03
## [1017,] 2.02010237  -2.178740e-02
## [1018,] 2.02067195  -2.106049e-02
## [1019,] 2.02410500  -1.459896e-02
## [1020,] 2.02958145  -8.478620e-04
## [1021,] 2.05288202   3.290086e-03
## [1022,] 2.05291381   3.292838e-03
## [1023,] 2.07578033   8.615129e-03
## [1024,] 2.08542841   2.155788e-02
## [1025,] 2.08809503   3.196173e-02
## [1026,] 2.09102865   3.205123e-02
## [1027,] 2.09248254   3.960246e-02
## [1028,] 2.09253635   3.979664e-02
## [1029,] 2.09394453   4.493615e-02
## [1030,] 2.14931105   3.683688e-02
## [1031,] 2.15070054   2.794302e-02
## [1032,] 2.15607810   2.199177e-02
## [1033,] 2.17386185   2.209233e-02
## [1034,] 2.17694131   2.157821e-02
## [1035,] 2.19845066   1.948096e-02
## [1036,] 2.21351126   1.863886e-02
## [1037,] 2.21474229   1.860327e-02
## [1038,] 2.23244622   2.171071e-02
## [1039,] 2.23899941   3.340671e-02
## [1040,] 2.25214771   4.672452e-02
## [1041,] 2.26015654   4.599907e-02
## [1042,] 2.26621080   3.742582e-02
## [1043,] 2.27017468   3.174452e-02
## [1044,] 2.30362028   3.131168e-02
## [1045,] 2.32133959   3.132344e-02
## [1046,] 2.35752973   2.949658e-02
## [1047,] 2.44032500   2.575735e-02
## [1048,] 2.48658063   1.779084e-02
## [1049,] 2.50639506   1.665403e-02
## [1050,] 2.51091451   1.633037e-02
## [1051,] 2.67453262   3.853474e-03
## [1052,] 2.68757750   3.657756e-03
## [1053,] 2.72133630   1.359289e-02
## [1054,] 3.28912288   2.539532e-03
## [1055,] 3.29452704   1.965198e-03
ggplot(table.diff, aes(x=alpha.vals, diff.geom_corr))+geom_point()

area.acumulada <- cumsum(c(0, diff.geom_corr[-1] * diff(alpha.vals))) 
area.acumulada #analizar esto
##    [1]  0.000000e+00  6.809045e-08  1.301971e-07  2.287676e-07  2.600994e-07
##    [6]  5.982050e-07  9.918256e-07  1.272449e-06  1.302389e-06  1.357039e-06
##   [11]  1.408440e-06  1.424892e-06  1.586687e-06  1.667166e-06  2.002689e-06
##   [16]  2.107006e-06  2.159113e-06  2.229729e-06  2.263975e-06  2.275172e-06
##   [21]  2.470246e-06  2.472418e-06  2.479000e-06  2.478144e-06  2.524822e-06
##   [26]  2.617387e-06  2.754284e-06  2.763194e-06  2.877397e-06  2.898982e-06
##   [31]  2.919684e-06  2.922546e-06  2.815123e-06  2.745614e-06  2.693813e-06
##   [36]  2.689779e-06  2.565520e-06  2.513866e-06  2.505977e-06  2.469821e-06
##   [41]  2.250348e-06  1.766024e-06  1.338754e-06  1.283713e-06  1.223653e-06
##   [46]  5.903911e-07  3.026314e-08 -5.246049e-07 -9.283528e-07 -1.149905e-06
##   [51] -1.392632e-06 -1.682361e-06 -1.792813e-06 -2.093269e-06 -2.621688e-06
##   [56] -2.709580e-06 -2.757505e-06 -2.936272e-06 -3.076562e-06 -3.528689e-06
##   [61] -3.753329e-06 -3.923921e-06 -3.961465e-06 -3.976074e-06 -4.042904e-06
##   [66] -4.066267e-06 -4.363968e-06 -5.812963e-06 -5.823753e-06 -6.338801e-06
##   [71] -6.544482e-06 -6.851994e-06 -6.975074e-06 -7.053271e-06 -7.125909e-06
##   [76] -7.257707e-06 -7.285519e-06 -7.463432e-06 -7.440168e-06 -7.417353e-06
##   [81] -7.390081e-06 -7.373853e-06 -7.274392e-06 -7.252506e-06 -7.219204e-06
##   [86] -7.171884e-06 -7.149887e-06 -7.135785e-06 -7.168586e-06 -7.177984e-06
##   [91] -7.179963e-06 -7.689397e-06 -7.865254e-06 -7.862238e-06 -7.718134e-06
##   [96] -7.700649e-06 -7.551935e-06 -7.467064e-06 -7.460274e-06 -7.416575e-06
##  [101] -7.226274e-06 -7.199629e-06 -7.375939e-06 -8.330858e-06 -8.511006e-06
##  [106] -8.580942e-06 -8.766204e-06 -8.768350e-06 -8.775461e-06 -8.789413e-06
##  [111] -8.826584e-06 -8.894601e-06 -8.999991e-06 -9.065675e-06 -9.148454e-06
##  [116] -9.227434e-06 -9.751951e-06 -9.843344e-06 -1.025653e-05 -1.048482e-05
##  [121] -1.079549e-05 -1.134017e-05 -1.143860e-05 -1.151135e-05 -1.152216e-05
##  [126] -1.149833e-05 -1.144287e-05 -1.143467e-05 -1.141053e-05 -1.139973e-05
##  [131] -1.143160e-05 -1.139092e-05 -1.139182e-05 -1.138495e-05 -1.138452e-05
##  [136] -1.140643e-05 -1.143789e-05 -1.144735e-05 -1.205921e-05 -1.206773e-05
##  [141] -1.206789e-05 -1.202011e-05 -1.200679e-05 -1.200444e-05 -1.204543e-05
##  [146] -1.224353e-05 -1.223169e-05 -1.223102e-05 -1.223181e-05 -1.227311e-05
##  [151] -1.266989e-05 -1.277542e-05 -1.278126e-05 -1.278242e-05 -1.294271e-05
##  [156] -1.315360e-05 -1.317923e-05 -1.327600e-05 -1.356870e-05 -1.404275e-05
##  [161] -1.411209e-05 -1.502714e-05 -1.520354e-05 -1.643754e-05 -1.688133e-05
##  [166] -1.702414e-05 -1.727769e-05 -1.786595e-05 -1.886026e-05 -1.915445e-05
##  [171] -1.922812e-05 -1.927459e-05 -2.015672e-05 -2.017562e-05 -2.044429e-05
##  [176] -2.095005e-05 -2.139203e-05 -2.272243e-05 -2.361268e-05 -2.398336e-05
##  [181] -2.435695e-05 -2.437299e-05 -2.474534e-05 -2.482110e-05 -2.477332e-05
##  [186] -2.306763e-05 -2.210099e-05 -2.160635e-05 -2.122737e-05 -2.113849e-05
##  [191] -2.058328e-05 -2.045900e-05 -1.952270e-05 -1.852308e-05 -1.794644e-05
##  [196] -1.742299e-05 -1.735377e-05 -1.718949e-05 -1.482064e-05 -1.472284e-05
##  [201] -1.383964e-05 -1.382039e-05 -1.123212e-05 -7.791435e-06 -6.943742e-06
##  [206] -6.505023e-06 -6.037644e-06 -5.705948e-06 -5.667878e-06 -5.573163e-06
##  [211] -5.532645e-06 -4.067066e-06 -2.960017e-06 -6.982460e-07 -3.572138e-07
##  [216]  1.089355e-07  4.858791e-07  2.471773e-06  3.075043e-06  4.075492e-06
##  [221]  5.436140e-06  6.371062e-06  6.879927e-06  7.079380e-06  7.443940e-06
##  [226]  9.119561e-06  1.019679e-05  1.353804e-05  1.498511e-05  1.541165e-05
##  [231]  1.696627e-05  1.697513e-05  1.709045e-05  1.728912e-05  1.756612e-05
##  [236]  1.770784e-05  1.891533e-05  1.943438e-05  1.991302e-05  2.057892e-05
##  [241]  2.093709e-05  2.224421e-05  2.226312e-05  2.231715e-05  2.261710e-05
##  [246]  2.297875e-05  2.330768e-05  2.428108e-05  2.478759e-05  2.512703e-05
##  [251]  2.588084e-05  2.890455e-05  3.054081e-05  3.532570e-05  3.546893e-05
##  [256]  3.558277e-05  3.786146e-05  3.843872e-05  4.047647e-05  4.054040e-05
##  [261]  4.202734e-05  4.400054e-05  4.550778e-05  4.804107e-05  4.902950e-05
##  [266]  4.987498e-05  5.026324e-05  5.123372e-05  5.214436e-05  5.545937e-05
##  [271]  5.782239e-05  5.926571e-05  5.960836e-05  6.029896e-05  6.222956e-05
##  [276]  6.446070e-05  6.534807e-05  6.838480e-05  6.990953e-05  7.449212e-05
##  [281]  7.541766e-05  7.594103e-05  7.626878e-05  7.898000e-05  7.994969e-05
##  [286]  8.098387e-05  8.214611e-05  8.278977e-05  8.576777e-05  8.608111e-05
##  [291]  8.710977e-05  8.879300e-05  8.935788e-05  8.999550e-05  9.087812e-05
##  [296]  9.091635e-05  9.186903e-05  9.293038e-05  9.459586e-05  9.519560e-05
##  [301]  9.561285e-05  9.665263e-05  9.731989e-05  9.753693e-05  9.761117e-05
##  [306]  9.763400e-05  9.810879e-05  9.839107e-05  9.830445e-05  9.824888e-05
##  [311]  9.792146e-05  9.791910e-05  9.799657e-05  9.823080e-05  9.858684e-05
##  [316]  9.861280e-05  9.856230e-05  9.856223e-05  9.886718e-05  9.914254e-05
##  [321]  9.968131e-05  1.058725e-04  1.059156e-04  1.063259e-04  1.065169e-04
##  [326]  1.080578e-04  1.087676e-04  1.102718e-04  1.106456e-04  1.106427e-04
##  [331]  1.102400e-04  1.101309e-04  1.092555e-04  1.090513e-04  1.091729e-04
##  [336]  1.092359e-04  1.096770e-04  1.117899e-04  1.120652e-04  1.130392e-04
##  [341]  1.131890e-04  1.132353e-04  1.136337e-04  1.136421e-04  1.139020e-04
##  [346]  1.141350e-04  1.143405e-04  1.144224e-04  1.145714e-04  1.148663e-04
##  [351]  1.148731e-04  1.166449e-04  1.177958e-04  1.178424e-04  1.179302e-04
##  [356]  1.177204e-04  1.152458e-04  1.150784e-04  1.149325e-04  1.162807e-04
##  [361]  1.166876e-04  1.171490e-04  1.173320e-04  1.185569e-04  1.189368e-04
##  [366]  1.191614e-04  1.196162e-04  1.198493e-04  1.211378e-04  1.226964e-04
##  [371]  1.231880e-04  1.257019e-04  1.270796e-04  1.282798e-04  1.292788e-04
##  [376]  1.308748e-04  1.312722e-04  1.313501e-04  1.314133e-04  1.320430e-04
##  [381]  1.331504e-04  1.331366e-04  1.331361e-04  1.335188e-04  1.336809e-04
##  [386]  1.342599e-04  1.352332e-04  1.369290e-04  1.386468e-04  1.395805e-04
##  [391]  1.477973e-04  1.487416e-04  1.494150e-04  1.512666e-04  1.552129e-04
##  [396]  1.560792e-04  1.576169e-04  1.579600e-04  1.655445e-04  1.668729e-04
##  [401]  1.690147e-04  1.694854e-04  1.758422e-04  1.759626e-04  1.761664e-04
##  [406]  1.762209e-04  1.817849e-04  1.821804e-04  1.834617e-04  1.835447e-04
##  [411]  1.873495e-04  1.886194e-04  1.892349e-04  1.896550e-04  1.931725e-04
##  [416]  1.939934e-04  1.940303e-04  1.956609e-04  2.011475e-04  2.013909e-04
##  [421]  2.019317e-04  2.019963e-04  2.026392e-04  2.050080e-04  2.062047e-04
##  [426]  2.062345e-04  2.064048e-04  2.071690e-04  2.076694e-04  2.105554e-04
##  [431]  2.107305e-04  2.109283e-04  2.110599e-04  2.110803e-04  2.118126e-04
##  [436]  2.118788e-04  2.118402e-04  2.116245e-04  2.113425e-04  2.109237e-04
##  [441]  2.105221e-04  2.100023e-04  2.099949e-04  2.100855e-04  2.102054e-04
##  [446]  2.105417e-04  2.132661e-04  2.133428e-04  2.140349e-04  2.157590e-04
##  [451]  2.162783e-04  2.180051e-04  2.228170e-04  2.233767e-04  2.421107e-04
##  [456]  2.633480e-04  2.642377e-04  2.648224e-04  2.650905e-04  2.669145e-04
##  [461]  2.714147e-04  2.734109e-04  2.788596e-04  2.791378e-04  2.934075e-04
##  [466]  2.973297e-04  2.993303e-04  3.003745e-04  3.119597e-04  3.142360e-04
##  [471]  3.194512e-04  3.208895e-04  3.250214e-04  3.366078e-04  3.417719e-04
##  [476]  3.433709e-04  3.576124e-04  3.707027e-04  3.709277e-04  3.784172e-04
##  [481]  3.852026e-04  3.890778e-04  4.018917e-04  4.216441e-04  4.252740e-04
##  [486]  4.355172e-04  4.374389e-04  4.393077e-04  4.470391e-04  4.559091e-04
##  [491]  4.560504e-04  4.570873e-04  4.657963e-04  5.035892e-04  5.055701e-04
##  [496]  5.335635e-04  5.388536e-04  5.430530e-04  5.439253e-04  5.450306e-04
##  [501]  5.463708e-04  5.478408e-04  5.666969e-04  5.954090e-04  6.097974e-04
##  [506]  6.532561e-04  6.614450e-04  6.684607e-04  6.822337e-04  6.852159e-04
##  [511]  7.036571e-04  7.434847e-04  7.636160e-04  7.821754e-04  7.996555e-04
##  [516]  8.054063e-04  8.183081e-04  8.475189e-04  8.626425e-04  8.706705e-04
##  [521]  8.840705e-04  8.973795e-04  9.253893e-04  9.645838e-04  9.718968e-04
##  [526]  9.738290e-04  9.768567e-04  1.062926e-03  1.069557e-03  1.108398e-03
##  [531]  1.130833e-03  1.175752e-03  1.215396e-03  1.217996e-03  1.242111e-03
##  [536]  1.245919e-03  1.250335e-03  1.267187e-03  1.300743e-03  1.315506e-03
##  [541]  1.329474e-03  1.399315e-03  1.420250e-03  1.420811e-03  1.477026e-03
##  [546]  1.499759e-03  1.526808e-03  1.542092e-03  1.553369e-03  1.568851e-03
##  [551]  1.581712e-03  1.596877e-03  1.675478e-03  1.723990e-03  1.727113e-03
##  [556]  1.728765e-03  1.736433e-03  1.783410e-03  1.807152e-03  1.858979e-03
##  [561]  1.914561e-03  1.922297e-03  1.954825e-03  1.980871e-03  2.005731e-03
##  [566]  2.084938e-03  2.086535e-03  2.096796e-03  2.097248e-03  2.101801e-03
##  [571]  2.104649e-03  2.116918e-03  2.123260e-03  2.178421e-03  2.239831e-03
##  [576]  2.250598e-03  2.312568e-03  2.317146e-03  2.364946e-03  2.365683e-03
##  [581]  2.388791e-03  2.441207e-03  2.471706e-03  2.517740e-03  2.539683e-03
##  [586]  2.547753e-03  2.566312e-03  2.572506e-03  2.629522e-03  2.636561e-03
##  [591]  2.650496e-03  2.666649e-03  2.706262e-03  2.731076e-03  2.749665e-03
##  [596]  2.752340e-03  2.766718e-03  2.778842e-03  2.780702e-03  2.812093e-03
##  [601]  2.814577e-03  2.814625e-03  2.825248e-03  2.865194e-03  2.866515e-03
##  [606]  2.877263e-03  2.881732e-03  2.895788e-03  2.915903e-03  2.958498e-03
##  [611]  2.987793e-03  2.997928e-03  3.053530e-03  3.101583e-03  3.148248e-03
##  [616]  3.187946e-03  3.189973e-03  3.198852e-03  3.225887e-03  3.250524e-03
##  [621]  3.253564e-03  3.269490e-03  3.293825e-03  3.343262e-03  3.347859e-03
##  [626]  3.374908e-03  3.375517e-03  3.380525e-03  3.382803e-03  3.392380e-03
##  [631]  3.438048e-03  3.467534e-03  3.533629e-03  3.586910e-03  3.666938e-03
##  [636]  3.683972e-03  3.708280e-03  3.729865e-03  3.737228e-03  3.773088e-03
##  [641]  3.793158e-03  3.843826e-03  3.932251e-03  3.969387e-03  3.971166e-03
##  [646]  4.002670e-03  4.002993e-03  4.014222e-03  4.092484e-03  4.101273e-03
##  [651]  4.116240e-03  4.172668e-03  4.209258e-03  4.226489e-03  4.253428e-03
##  [656]  4.268379e-03  4.290877e-03  4.328359e-03  4.369465e-03  4.417616e-03
##  [661]  4.418101e-03  4.472895e-03  4.534289e-03  4.561821e-03  4.567148e-03
##  [666]  4.575872e-03  4.607558e-03  4.669803e-03  4.686069e-03  4.732613e-03
##  [671]  4.782944e-03  4.786248e-03  4.805189e-03  4.827649e-03  4.884553e-03
##  [676]  4.924106e-03  4.963695e-03  5.007642e-03  5.046211e-03  5.127521e-03
##  [681]  5.129163e-03  5.213558e-03  5.287425e-03  5.382621e-03  5.403901e-03
##  [686]  5.439120e-03  5.493896e-03  5.544642e-03  5.611753e-03  5.636168e-03
##  [691]  5.661325e-03  5.758837e-03  5.782625e-03  5.865388e-03  5.985479e-03
##  [696]  6.289235e-03  6.358179e-03  6.524165e-03  6.549468e-03  6.639991e-03
##  [701]  6.679289e-03  6.916434e-03  7.060604e-03  7.181597e-03  7.186236e-03
##  [706]  7.208354e-03  7.265974e-03  7.268533e-03  7.284917e-03  7.335641e-03
##  [711]  7.421184e-03  7.430256e-03  7.469675e-03  7.531363e-03  7.540944e-03
##  [716]  7.546501e-03  7.690677e-03  7.724547e-03  7.753447e-03  7.824828e-03
##  [721]  7.881495e-03  7.882661e-03  7.961000e-03  7.983838e-03  8.093154e-03
##  [726]  8.157447e-03  8.213895e-03  8.252704e-03  8.292952e-03  8.333929e-03
##  [731]  8.343924e-03  8.360250e-03  8.373534e-03  8.421985e-03  8.435201e-03
##  [736]  8.486459e-03  8.552245e-03  8.681108e-03  8.740994e-03  8.892466e-03
##  [741]  8.922972e-03  9.095996e-03  9.178070e-03  9.346918e-03  9.349610e-03
##  [746]  9.396858e-03  9.503894e-03  9.673569e-03  9.685474e-03  9.830782e-03
##  [751]  9.856289e-03  9.951465e-03  9.970463e-03  9.970860e-03  1.007264e-02
##  [756]  1.008671e-02  1.014048e-02  1.021155e-02  1.023521e-02  1.027798e-02
##  [761]  1.029112e-02  1.049771e-02  1.051612e-02  1.055656e-02  1.056006e-02
##  [766]  1.061518e-02  1.065869e-02  1.097816e-02  1.104801e-02  1.116791e-02
##  [771]  1.139182e-02  1.144948e-02  1.149939e-02  1.169985e-02  1.173767e-02
##  [776]  1.174145e-02  1.176873e-02  1.184005e-02  1.201210e-02  1.223037e-02
##  [781]  1.224302e-02  1.227948e-02  1.235717e-02  1.240009e-02  1.253505e-02
##  [786]  1.272076e-02  1.284645e-02  1.289429e-02  1.297650e-02  1.301828e-02
##  [791]  1.306116e-02  1.336508e-02  1.337682e-02  1.357121e-02  1.359128e-02
##  [796]  1.363169e-02  1.366681e-02  1.374847e-02  1.378229e-02  1.378686e-02
##  [801]  1.401012e-02  1.408550e-02  1.415275e-02  1.426955e-02  1.435813e-02
##  [806]  1.447339e-02  1.451451e-02  1.474491e-02  1.479782e-02  1.482380e-02
##  [811]  1.496929e-02  1.537067e-02  1.557316e-02  1.579716e-02  1.583446e-02
##  [816]  1.584400e-02  1.596827e-02  1.611560e-02  1.635842e-02  1.638366e-02
##  [821]  1.641301e-02  1.643339e-02  1.644307e-02  1.644673e-02  1.658709e-02
##  [826]  1.665921e-02  1.669630e-02  1.673115e-02  1.705415e-02  1.711655e-02
##  [831]  1.722993e-02  1.723904e-02  1.724475e-02  1.751993e-02  1.763938e-02
##  [836]  1.787035e-02  1.791136e-02  1.798655e-02  1.806449e-02  1.806682e-02
##  [841]  1.813037e-02  1.825226e-02  1.826115e-02  1.829917e-02  1.834331e-02
##  [846]  1.836402e-02  1.908761e-02  1.950887e-02  1.951579e-02  1.959331e-02
##  [851]  1.972767e-02  1.981416e-02  1.989974e-02  2.000906e-02  2.021012e-02
##  [856]  2.022982e-02  2.031226e-02  2.031929e-02  2.041615e-02  2.043963e-02
##  [861]  2.044132e-02  2.064088e-02  2.068073e-02  2.073184e-02  2.073736e-02
##  [866]  2.075222e-02  2.075428e-02  2.076226e-02  2.076868e-02  2.077378e-02
##  [871]  2.079473e-02  2.081805e-02  2.081890e-02  2.081890e-02  2.081694e-02
##  [876]  2.081621e-02  2.080481e-02  2.077021e-02  2.076230e-02  2.068235e-02
##  [881]  2.066632e-02  2.066537e-02  2.061275e-02  2.057211e-02  2.049870e-02
##  [886]  2.048782e-02  2.048138e-02  2.048174e-02  2.052214e-02  2.052920e-02
##  [891]  2.058663e-02  2.058791e-02  2.060567e-02  2.064128e-02  2.065527e-02
##  [896]  2.066350e-02  2.066488e-02  2.067937e-02  2.075183e-02  2.093869e-02
##  [901]  2.115785e-02  2.119299e-02  2.120943e-02  2.135458e-02  2.137169e-02
##  [906]  2.140017e-02  2.162020e-02  2.168968e-02  2.191825e-02  2.206210e-02
##  [911]  2.215940e-02  2.227834e-02  2.228073e-02  2.228275e-02  2.229640e-02
##  [916]  2.229658e-02  2.242077e-02  2.261707e-02  2.281376e-02  2.328486e-02
##  [921]  2.337092e-02  2.346952e-02  2.359580e-02  2.367549e-02  2.429661e-02
##  [926]  2.433143e-02  2.454004e-02  2.454517e-02  2.455391e-02  2.455506e-02
##  [931]  2.463800e-02  2.465726e-02  2.468520e-02  2.473417e-02  2.481264e-02
##  [936]  2.498690e-02  2.506513e-02  2.525910e-02  2.536193e-02  2.538771e-02
##  [941]  2.561795e-02  2.564728e-02  2.570233e-02  2.573929e-02  2.576950e-02
##  [946]  2.581249e-02  2.587874e-02  2.591765e-02  2.603081e-02  2.605475e-02
##  [951]  2.607566e-02  2.615127e-02  2.621285e-02  2.624594e-02  2.628101e-02
##  [956]  2.630245e-02  2.632555e-02  2.635929e-02  2.636812e-02  2.639961e-02
##  [961]  2.653286e-02  2.654157e-02  2.655998e-02  2.658220e-02  2.659850e-02
##  [966]  2.690553e-02  2.695782e-02  2.734616e-02  2.736412e-02  2.752511e-02
##  [971]  2.754877e-02  2.764383e-02  2.781355e-02  2.783304e-02  2.790200e-02
##  [976]  2.805784e-02  2.820658e-02  2.829758e-02  2.840073e-02  2.846629e-02
##  [981]  2.850817e-02  2.850939e-02  2.848070e-02  2.847525e-02  2.842021e-02
##  [986]  2.840947e-02  2.839386e-02  2.839291e-02  2.837215e-02  2.836668e-02
##  [991]  2.837284e-02  2.840079e-02  2.859615e-02  2.871852e-02  2.879672e-02
##  [996]  2.882966e-02  2.885850e-02  2.913418e-02  2.917566e-02  2.928167e-02
## [1001]  2.931551e-02  2.934791e-02  2.937936e-02  2.944128e-02  2.945098e-02
## [1006]  2.947739e-02  2.971470e-02  2.983991e-02  2.986524e-02  2.987428e-02
## [1011]  2.987940e-02  2.998062e-02  2.998090e-02  2.997943e-02  2.997007e-02
## [1016]  2.995955e-02  2.962840e-02  2.961640e-02  2.956628e-02  2.956164e-02
## [1021]  2.963830e-02  2.963840e-02  2.983540e-02  3.004340e-02  3.012862e-02
## [1026]  3.022265e-02  3.028023e-02  3.028237e-02  3.034565e-02  3.238518e-02
## [1031]  3.242400e-02  3.254227e-02  3.293515e-02  3.300160e-02  3.342062e-02
## [1036]  3.370134e-02  3.372424e-02  3.410860e-02  3.432752e-02  3.494187e-02
## [1041]  3.531027e-02  3.553685e-02  3.566269e-02  3.670992e-02  3.726495e-02
## [1046]  3.833244e-02  4.046503e-02  4.128795e-02  4.161794e-02  4.169175e-02
## [1051]  4.232224e-02  4.236996e-02  4.282884e-02  4.427075e-02  4.428137e-02
data.acumulada <- data.frame(alpha = alpha.vals, area = area.acumulada)
head(data.acumulada)
##        alpha         area
## 1 0.05751881 0.000000e+00
## 2 0.07104237 6.809045e-08
## 3 0.07929438 1.301971e-07
## 4 0.08378608 2.287676e-07
## 5 0.08510697 2.600994e-07
## 6 0.09448835 5.982050e-07
p <- ggplot(data.acumulada, aes(x = alpha, y = area.acumulada)) +
  geom_line(size = 1, color = "blue") +
  labs(
    title = "Área Acumulada entre las Curvas",
    x = "Alpha",
    y = "Área Acumulada"
  ) +
  theme_minimal()

 ggplotly(p)
# Derivada.

tasa.cambio <- diff(area.acumulada) / diff(alpha.vals)
alpha.medios <- (alpha.vals[-1] + alpha.vals[-length(alpha.vals)])/2
data.derivada <- data.frame(alpha = alpha.medios, tasadecambio = tasa.cambio)

p.derivada <- ggplot(data.derivada, aes(x = alpha, y = tasa.cambio)) +
  geom_line(size = 1, color = "red") +
  labs(
    title = "Tasa de Cambio de la Función Acumulada",
    x = "Alpha",
    y = "Derivada (Tasa de Cambio)"
  ) +
  theme_minimal()

ggplotly(p.derivada)

8 Ejemplo 4. Con la tabla de datos abalone.

8.1 Método de centros.

Primero, se tiene una tabla de datos simbólica de tipo intervalo, por ejemplo abalone de RSDA. Se obtiene la matriz de centros asociada.

data <- abalone
data.c <- interval.centers(data) 
data.c <- round(data.c,2)

Sobre la matriz de centros, se aplica un modelo de regresión lineal clásico. Supongamos que se aplica un modelo de regresión lineal tomando como variable de respuesta Whole_Weight.

modelo.c <- lm(WHOLE_WEIGHT ~., data.c)

El modelo es: \(Y=-0.1834758-0.2693955X_{1}+1.4948113X_{2}+0.1146723X_{3}+0.6348267X_{4}+0.9660136X_{5}+0.8327747X_{6}\).

Y.c <- modelo.c$fitted.values 
Y.c <- round(Y.c,2)

Luego, se estudia la contribución de cada variable predictora al modelo a través del diagrama de dispersión asociado.

8.1.1 Contribución de la variable LENGTH al modelo de centros.

data.c1 <- cbind(data.c[,-4],Y.c) 

ggplot(data.c1, aes(x = LENGTH, y = Y.c))+geom_point()+labs(title = "LENGTH vs. Y") 

Lo que se está haciendo en realidad es tomar los centros de las observaciones de cada variable predictora como representantes de cada rectángulo de la agrupación rectangular formada por la variable predictora y la variable dependiente del modelo de regresión.

Gráficamente:

modelo1 <- sym.lm(WHOLE_WEIGHT ~ ., sym.data = abalone, method = "cm") 
ypred1 <- sym.predict(modelo1, abalone)
ypred1$Fitted$Minimums <- round(ypred1$Fitted$Minimums, 2)
ypred1$Fitted$Maximums <- round(ypred1$Fitted$Maximums, 2)

length1 <- data.frame(lengthmin=c(0.28,0.30,0.34,0.39,0.40,0.45,0.49,0.55,0.08,0.13,0.26,0.32,0.34,0.44,0.45,0.16,0.16,0.20,0.29,0.35,0.42,0.49,0.52,0.60),lengthmax=c(0.66,0.74,0.78,0.82,0.74,0.80,0.72,0.70,0.24,0.58,0.67,0.66,0.72,0.65,0.58,0.21,0.53,0.72,0.78,0.76,0.78,0.74,0.69,0.66)) #variable LENGTH

clusters1 <- cbind(length1,ypred1$Fitted)
colnames(clusters1) <- c('lengthmin','lengthmax','ymin','ymax')
rectangulos1 <- ggplot() + geom_rect(data = clusters1,
    aes(xmin = lengthmin, xmax = lengthmax, ymin = ymin, ymax = ymax),
    fill = "blue", alpha = 0.1, color = "black"
  ) +
  labs(
    title = "Centers for the variable LENGTH",
    x = "LENGTH",
    y = "Y"
  ) +
  theme_minimal()

graf1 <- rectangulos1 + 
  geom_point(
    data = clusters1, 
    aes(x = (lengthmin+lengthmax)/2, y = (ymin+ymax)/2), 
    color = "orange", size = 2, alpha = 0.9
  )

graf1 

Luego, se calcula el índice de bondad de ajuste geométrico.

indice1 <- spatgeom(y=data.c1$Y.c, x=data.c1[,-7]) 
## Running with x and y
## Index estimation
## Estimating R2 Geom for variable = 1
## Estimating R2 Geom for variable = 2
## Estimating R2 Geom for variable = 3
## Estimating R2 Geom for variable = 4
## Estimating R2 Geom for variable = 5
## Estimating R2 Geom for variable = 6
plot_curve(indice1, type = "curve")

plot_curve(indice1, type = "deriv")

8.2 Método de centros y rangos.

Ahora, además de la matriz de centros se crea la matriz de rangos y se estudian los centros más rangos y los centros menos rangos.

data.r <- interval.ranges(data) 
data.r <- round(data.r,2)
data.cmasr <- data.c + data.r
data.cmenosr <- data.c - data.r

Se crea un modelo de regresión lineal clásico con los centros más rangos.

modelo.cmasr <- lm(WHOLE_WEIGHT ~., data.cmasr)

El modelo es \(Y=-0.19494+0.77978X_{1}-0.05459X_{2}+0.06312X_{3}+0.63785X_{4}+1.28787X_{5}+0.89348X_{6}\)

Y.cmasr <- modelo.cmasr$fitted.values 
Y.cmasr <- round(Y.cmasr,2)

Luego, se estudia la contribución de cada variable predictora al modelo a través del diagrama de dispersión asociado.

8.2.1 Contribución de la variable LENGTH al modelo de centros más rangos.

data.cmasr1 <- cbind(data.cmasr[,-4],Y.cmasr)
ggplot(data.cmasr1, aes(x = LENGTH, y = Y.cmasr))+geom_point()+labs(title = "LENGTH vs. Y") #Nube de puntos LENGTH vs Y.cmasr

modelo2 <- sym.lm(WHOLE_WEIGHT ~ ., sym.data = abalone, method = "crm") 
ypred2 <- sym.predict(modelo2, abalone)
ypred2$Fitted$Minimums <- round(ypred2$Fitted$Minimums, 2)
ypred2$Fitted$Maximums <- round(ypred2$Fitted$Maximums, 2)

clusters2 <- cbind(length1,ypred2$Fitted)
colnames(clusters2) <- c('lengthmin','lengthmax','ymin','ymax')

rectangulos2 <- ggplot() + geom_rect(data = clusters2,
    aes(xmin = lengthmin, xmax = lengthmax, ymin = ymin, ymax = ymax),
    fill = "blue", alpha = 0.1, color = "black"
  ) +
  labs(
    title = "Centers plus ranges for the variable LENGTH", x="LENGTH",
    y = "Y"
  ) +
  theme_minimal()

graf2 <- rectangulos2 + 
  geom_point(
    data = clusters2, 
    aes(x = lengthmax, y = ymax), 
    color = "red", size = 3, alpha = 0.9
  )

graf2

indice2 <- spatgeom(y=data.cmasr1$Y.cmasr, x=data.cmasr1[,-7]) 
## Running with x and y
## Index estimation
## Estimating R2 Geom for variable = 1
## Estimating R2 Geom for variable = 2
## Estimating R2 Geom for variable = 3
## Estimating R2 Geom for variable = 4
## Estimating R2 Geom for variable = 5
## Estimating R2 Geom for variable = 6
indice2
## 
## Call:
## spatgeom_xy(x = x, y = y, scale = scale, nalphas = nalphas, envelope = envelope,     mc_cores = mc_cores)
## 
## Number of variables: 6 
## 
## Number of observations: 24 
## # A tibble: 6 × 5
##   variable_name  mean_n intensity alpha          geom_corr    
##   <chr>           <dbl>     <dbl> <fct>          <fct>        
## 1 DIAMETER           24     16.4  (0.034,0.697]  (0.91,0.999] 
## 2 HEIGHT             24      7.74 (0.0257,0.637] (0.777,1]    
## 3 LENGTH             24     13.9  (0.0306,0.748] (0.912,1]    
## 4 SHELL_WEIGHT       24      8.45 (0.0521,0.603] (0.879,1]    
## 5 SHUCKED_WEIGHT     24      5.65 (0.0507,0.791] (0.909,1]    
## 6 VISCERA_WEIGHT     24     11.1  (0.0404,0.444] (0.937,0.999]
plot_curve(indice2, type = "curve")

plot_curve(indice2, type = "deriv")

Se repite lo anterior, pero ahora usando centros menos rangos.

modelo.cmenosr <- lm(WHOLE_WEIGHT ~., data.cmenosr)

El modelo es \(Y=-0.01563+1.11565X_{1}-1.39136X_{2}-0.05412X_{3}+0.30067X_{4}+1.70071X_{5}+1.77761X_{6}\)

Y.cmenosr <- modelo.cmenosr$fitted.values 
Y.cmenosr <- round(Y.cmenosr,2)

8.2.2 Contribución de la variable LENGTH al modelo de centros menos rangos.

data.cmenosr1 <- cbind(data.cmenosr[,-4],Y.cmenosr)
ggplot(data.cmenosr1, aes(x = LENGTH, y = Y.cmenosr))+geom_point()+labs(title = "LENGTH vs. Y") #Nube de puntos LENGTH vs Y.cmasr

modelo3 <- sym.lm(WHOLE_WEIGHT ~ ., sym.data = abalone, method = "crm") 
ypred3 <- sym.predict(modelo3, abalone)
ypred3$Fitted$Minimums <- round(ypred3$Fitted$Minimums,2)
ypred3$Fitted$Maximums <- round(ypred3$Fitted$Maximums,2)

clusters3 <- cbind(length1,ypred3$Fitted)
colnames(clusters3) <- c('lengthmin','lengthmax','ymin','ymax')

rectangulos3 <- ggplot() + geom_rect(data = clusters3,
    aes(xmin = lengthmin, xmax = lengthmax, ymin = ymin, ymax = ymax),
    fill = "blue", alpha = 0.1, color = "black"
  ) +
  labs(
    title = "Centers minus ranges for the variable LENGTH",
    x = "LENGTH",
    y = "Y"
  ) +
  theme_minimal()

graf3 <- rectangulos3 + 
  geom_point(data = clusters3, 
    aes(x = lengthmin, y = ymin), 
    color = "green", size = 3, alpha = 0.9
  )

graf3

indice3 <- spatgeom(y=data.cmenosr1$Y.cmenosr, x=data.cmenosr1[,-7]) 
## Running with x and y
## Index estimation
## Estimating R2 Geom for variable = 1
## Estimating R2 Geom for variable = 2
## Estimating R2 Geom for variable = 3
## Estimating R2 Geom for variable = 4
## Estimating R2 Geom for variable = 5
## Estimating R2 Geom for variable = 6
plot_curve(indice3, type = "curve")

plot_curve(indice3, type = "deriv")

8.2.3 Gráfica final para la variable LENGTH con el método de centros y rangos.

geom_indicesc <- indice1$results[[1]]$geom_indices #centros

geom_indicescmasr <- indice2$results[[1]]$geom_indices #centrosmasrangos
geom_indicescmasr1 <- geom_indicescmasr %>% group_by(alpha) %>% filter(geom_corr==max(geom_corr)) %>% ungroup() #Selección de los valores únicos de alpha, considerando el mínimo valor asociado en geom_corr
ggplot(geom_indicescmasr1, aes(x=alpha,y=geom_corr))+geom_point()

geom_indicescmenosr <- indice3$results[[1]]$geom_indices #centrosmenosrangos
geom_indicescmenosr1 <- geom_indicescmenosr %>% group_by(alpha) %>% filter(geom_corr==max(geom_corr)) %>% ungroup() #Selección de los valores únicos de alpha, considerando el máximo valor asociado en geom_corr
ggplot(geom_indicescmenosr1, aes(x=alpha,y=geom_corr))+geom_point()

# Etiquetas para identificar cada curva

geom_indicesc$label <- "centros"
geom_indicescmasr$label <- "centros más rangos"
geom_indicescmenosr$label <- "centros menos rangos"

# Combinar los datos
data_combined <- rbind(geom_indicesc,geom_indicescmasr, geom_indicescmenosr )
data_combined1 <- rbind(geom_indicescmasr1, geom_indicescmenosr1)
data_combined1 <- rbind(c(0,1),data_combined1)

# Crear el gráfico
ggplotly(ggplot(data_combined, aes(x = alpha, y = geom_corr, color = label)) +
  geom_step(size = 1) +
  labs(
    title = "Correlación geométrica para la variable Syst",
    x = "Alpha",
    y = "Geom_corr",
    color = "Curvas"
  ) +
  theme_minimal() +
  theme(legend.position = "bottom"))
#Área acumulada entre las curvas: centros menos rangos y centros más rangos.
library(pracma)

alpha.vals <- sort(unique(c(geom_indicescmasr1$alpha, geom_indicescmenosr1$alpha)))

geom_corr.cmasr <- approx(geom_indicescmasr1$alpha, geom_indicescmasr1$geom_corr, xout = alpha.vals, rule = 2)$y

geom_corr.cmenosr <- approx(geom_indicescmenosr1$alpha, geom_indicescmenosr1$geom_corr, xout = alpha.vals, rule = 2)$y

diff.geom_corr <- geom_corr.cmasr - geom_corr.cmenosr

table.cmasr <- cbind(alpha.vals, geom_corr.cmasr)
ggplot(table.cmasr, aes(x=alpha.vals, geom_corr.cmasr))+geom_point()

table.cmenosr <- cbind(alpha.vals, geom_corr.cmenosr)
ggplot(table.cmenosr, aes(x=alpha.vals, geom_corr.cmenosr))+geom_point()

table.diff <- cbind(alpha.vals, diff.geom_corr)
table.diff
##       alpha.vals diff.geom_corr
##  [1,] 0.01802776   0.0001120065
##  [2,] 0.02236068   0.0007425235
##  [3,] 0.02500000   0.0013730405
##  [4,] 0.02692582   0.0013730405
##  [5,] 0.02915476   0.0015306698
##  [6,] 0.03162278   0.0016882990
##  [7,] 0.03201562   0.0032645916
##  [8,] 0.03201562   0.0032645916
##  [9,] 0.03605551   0.0032808190
## [10,] 0.03640055   0.0034263714
## [11,] 0.03640055   0.0034263714
## [12,] 0.03905125   0.0040429249
## [13,] 0.04031129   0.0041564510
## [14,] 0.04031129   0.0041564510
## [15,] 0.04242641   0.0044860689
## [16,] 0.04716991   0.0057410552
## [17,] 0.04716991   0.0057410552
## [18,] 0.05000000   0.0047602901
## [19,] 0.06082763   0.0046183024
## [20,] 0.06403124   0.0027475600
## [21,] 0.06670832   0.0026580754
## [22,] 0.06946222   0.0070060729
## [23,] 0.07071068   0.0084096964
## [24,] 0.07158911   0.0083440835
## [25,] 0.07566373   0.0061061826
## [26,] 0.08000000   0.0031299895
## [27,] 0.08062258   0.0029436300
## [28,] 0.08544004   0.0036289790
## [29,] 0.09013878   0.0055382609
## [30,] 0.09013878   0.0055382609
## [31,] 0.09513149   0.0103554269
## [32,] 0.09552487   0.0104410471
## [33,] 0.09617692   0.0102122080
## [34,] 0.10000000   0.0111074824
## [35,] 0.10049876   0.0119487758
## [36,] 0.10124228   0.0134264555
## [37,] 0.10511898   0.0142874529
## [38,] 0.10793517   0.0143745133
## [39,] 0.11401754   0.0147249365
## [40,] 0.12539936   0.0170354227
## [41,] 0.12658989   0.0172764877
## [42,] 0.13536986   0.0195194870
## [43,] 0.13793114   0.0199042255
## [44,] 0.15074813   0.0186910880
## [45,] 0.16710775   0.0211025111
## [46,] 0.17066048   0.0221339335
## [47,] 0.17356555   0.0204585161
## [48,] 0.17464249   0.0200146978
## [49,] 0.17951323   0.0200584340
## [50,] 0.20099751   0.0269589484
## [51,] 0.22000000   0.0296404952
## [52,] 0.23505319   0.0335233383
## [53,] 0.23584953   0.0334318534
## [54,] 0.24135037   0.0373769500
## [55,] 0.24748737   0.0562651702
## [56,] 0.24839485   0.0594062508
## [57,] 0.29920729   0.0774123036
## [58,] 0.30008332   0.0777430629
## [59,] 0.31780497   0.0787324858
## [60,] 0.35510562   0.1191705005
## [61,] 0.36280160   0.1262083805
## [62,] 0.37406550   0.1280914689
## [63,] 0.47447339   0.1649297176
## [64,] 0.48703183   0.1673596859
## [65,] 0.58860003   0.1923946039
## [66,] 0.65370100   0.2076077809
## [67,] 1.06894808   0.1436509645
## [68,] 1.36792726   0.1272456219
## [69,] 1.46400990   0.1202479448
ggplot(table.diff, aes(x=alpha.vals, diff.geom_corr))+geom_point()

area.acumulada <- cumsum(c(0, diff.geom_corr[-1] * diff(alpha.vals))) #analizar esto
area.acumulada
##  [1] 0.000000e+00 3.217297e-06 6.841191e-06 9.485426e-06 1.289719e-05
##  [6] 1.706394e-05 1.834642e-05 1.834642e-05 3.160057e-05 3.278279e-05
## [11] 3.278279e-05 4.349937e-05 4.873667e-05 4.873667e-05 5.822523e-05
## [16] 8.545792e-05 8.545792e-05 9.892999e-05 1.489352e-04 1.577374e-04
## [21] 1.648532e-04 1.841473e-04 1.946464e-04 2.019761e-04 2.268565e-04
## [26] 2.404290e-04 2.422616e-04 2.597441e-04 2.857669e-04 2.857669e-04
## [31] 3.374685e-04 3.415758e-04 3.482347e-04 3.906995e-04 3.966591e-04
## [36] 4.066420e-04 4.620301e-04 5.025114e-04 5.920740e-04 7.859681e-04
## [41] 8.065363e-04 9.779169e-04 1.028897e-03 1.268461e-03 1.613690e-03
## [46] 1.692326e-03 1.751759e-03 1.773314e-03 1.871013e-03 2.450207e-03
## [51] 3.013450e-03 3.518083e-03 3.544706e-03 3.750311e-03 4.095610e-03
## [56] 4.149520e-03 8.083028e-03 8.151134e-03 9.546403e-03 1.399154e-02
## [61] 1.496284e-02 1.640565e-02 3.296589e-02 3.506767e-02 5.460884e-02
## [66] 6.812431e-02 1.277750e-01 1.658187e-01 1.773725e-01
data.acumulada <- data.frame(alpha = alpha.vals, area = area.acumulada)
data.acumulada
##         alpha         area
## 1  0.01802776 0.000000e+00
## 2  0.02236068 3.217297e-06
## 3  0.02500000 6.841191e-06
## 4  0.02692582 9.485426e-06
## 5  0.02915476 1.289719e-05
## 6  0.03162278 1.706394e-05
## 7  0.03201562 1.834642e-05
## 8  0.03201562 1.834642e-05
## 9  0.03605551 3.160057e-05
## 10 0.03640055 3.278279e-05
## 11 0.03640055 3.278279e-05
## 12 0.03905125 4.349937e-05
## 13 0.04031129 4.873667e-05
## 14 0.04031129 4.873667e-05
## 15 0.04242641 5.822523e-05
## 16 0.04716991 8.545792e-05
## 17 0.04716991 8.545792e-05
## 18 0.05000000 9.892999e-05
## 19 0.06082763 1.489352e-04
## 20 0.06403124 1.577374e-04
## 21 0.06670832 1.648532e-04
## 22 0.06946222 1.841473e-04
## 23 0.07071068 1.946464e-04
## 24 0.07158911 2.019761e-04
## 25 0.07566373 2.268565e-04
## 26 0.08000000 2.404290e-04
## 27 0.08062258 2.422616e-04
## 28 0.08544004 2.597441e-04
## 29 0.09013878 2.857669e-04
## 30 0.09013878 2.857669e-04
## 31 0.09513149 3.374685e-04
## 32 0.09552487 3.415758e-04
## 33 0.09617692 3.482347e-04
## 34 0.10000000 3.906995e-04
## 35 0.10049876 3.966591e-04
## 36 0.10124228 4.066420e-04
## 37 0.10511898 4.620301e-04
## 38 0.10793517 5.025114e-04
## 39 0.11401754 5.920740e-04
## 40 0.12539936 7.859681e-04
## 41 0.12658989 8.065363e-04
## 42 0.13536986 9.779169e-04
## 43 0.13793114 1.028897e-03
## 44 0.15074813 1.268461e-03
## 45 0.16710775 1.613690e-03
## 46 0.17066048 1.692326e-03
## 47 0.17356555 1.751759e-03
## 48 0.17464249 1.773314e-03
## 49 0.17951323 1.871013e-03
## 50 0.20099751 2.450207e-03
## 51 0.22000000 3.013450e-03
## 52 0.23505319 3.518083e-03
## 53 0.23584953 3.544706e-03
## 54 0.24135037 3.750311e-03
## 55 0.24748737 4.095610e-03
## 56 0.24839485 4.149520e-03
## 57 0.29920729 8.083028e-03
## 58 0.30008332 8.151134e-03
## 59 0.31780497 9.546403e-03
## 60 0.35510562 1.399154e-02
## 61 0.36280160 1.496284e-02
## 62 0.37406550 1.640565e-02
## 63 0.47447339 3.296589e-02
## 64 0.48703183 3.506767e-02
## 65 0.58860003 5.460884e-02
## 66 0.65370100 6.812431e-02
## 67 1.06894808 1.277750e-01
## 68 1.36792726 1.658187e-01
## 69 1.46400990 1.773725e-01
p <- ggplot(data.acumulada, aes(x = alpha, y = area.acumulada)) +
  geom_line(size = 1, color = "blue") +
  labs(
    title = "Área Acumulada entre las Curvas",
    x = "Alpha",
    y = "Área Acumulada"
  ) +
  theme_minimal()

ggplotly(p)
#Derivada.

tasa.cambio <- diff(area.acumulada) / diff(alpha.vals)
alpha.medios <- (alpha.vals[-1] + alpha.vals[-length(alpha.vals)])/2
data.derivada <- data.frame(alpha = alpha.medios, tasadecambio = tasa.cambio)

p.derivada <- ggplot(data.derivada, aes(x = alpha, y = tasa.cambio)) +
  geom_line(size = 1, color = "red") +
  labs(
    title = "Tasa de Cambio de la Función Acumulada",
    x = "Alpha",
    y = "Derivada (Tasa de Cambio)"
  ) +
  theme_minimal()

ggplotly(p.derivada)

8.2.4 Contribución de la variable DIAMETER al modelo de centros.

data.c1 <- cbind(data.c[,-4],Y.c) 
ggplot(data.c1, aes(x = DIAMETER, y = Y.c))+geom_point()+labs(title = "LENGTH vs. Y") 

Lo que se está haciendo en realidad es tomar los centros de las observaciones de cada variable predictora como representantes de cada rectángulo de la agrupación rectangular formada por la variable predictora y la variable dependiente del modelo de regresión.

Gráficamente:

diameter1 <- data.frame(lengthmin=c(0.20,0.22,0.26,0.30,0.32,0.38,0.36,0.46,0.06,0.10,0.20,0.24,0.26,0.33,0.36,0.11,0.12,0.16,0.22,0.26,0.32,0.38,0.40,0.50),lengthmax=c(0.48,0.58,0.63,0.65,0.60,0.63,0.58,0.58,0.18,0.45,0.50,0.52,0.55,0.52,0.44,0.15,0.41,0.57,0.63,0.60,0.59,0.59,0.54,0.54)) #variable DIAMETER

clusters1.1 <- cbind(diameter1,ypred1$Fitted)
colnames(clusters1.1) <- c('lengthmin','lengthmax','ymin','ymax')
rectangulos1.1 <- ggplot() + geom_rect(data = clusters1.1,
    aes(xmin = lengthmin, xmax = lengthmax, ymin = ymin, ymax = ymax),
    fill = "blue", alpha = 0.2, color = "black"
  ) +
  labs(
    title = "Centers for the variable DIAMETER",
    x = "DIAMETER",
    y = "Y"
  ) +
  theme_minimal()

graf1.1 <- rectangulos1.1 + 
  geom_point(
    data = clusters1.1, 
    aes(x = (lengthmin+lengthmax)/2, y = (ymin+ymax)/2), 
    color = "orange", size = 2, alpha = 0.9
  )

graf1.1

8.2.5 Contribución de la variable DIAMETER al modelo de centros más rangos.

data.cmasr1 <- cbind(data.cmasr[,-4],Y.cmasr)
ggplot(data.cmasr1, aes(x = DIAMETER, y = Y.cmasr))+geom_point()+labs(title = "DIAMETER vs. Y") 

clusters2.1 <- cbind(diameter1,ypred2$Fitted)
colnames(clusters2.1) <- c('lengthmin','lengthmax','ymin','ymax')

rectangulos2.1 <- ggplot() + geom_rect(data = clusters2.1,
    aes(xmin = lengthmin, xmax = lengthmax, ymin = ymin, ymax = ymax),
    fill = "blue", alpha = 0.1, color = "black"
  ) +
  labs(
    title = "Centers plus ranges for the variable DIAMETER", x="DIAMETER",
    y = "Y"
  ) +
  theme_minimal()

graf2.1 <- rectangulos2.1 + 
  geom_point(
    data = clusters2.1, 
    aes(x = lengthmax, y = ymax), 
    color = "red", size = 3, alpha = 0.9
  )

graf2.1

8.2.6 Contribución de la variable DIAMETER al modelo de centros menos rangos.

data.cmenosr1 <- cbind(data.cmenosr[,-4],Y.cmenosr)
ggplot(data.cmenosr1, aes(x = DIAMETER, y = Y.cmenosr))+geom_point()+labs(title = "DIAMETER vs. Y") 

clusters3.1 <- cbind(diameter1,ypred3$Fitted)
colnames(clusters3.1) <- c('lengthmin','lengthmax','ymin','ymax')

rectangulos3.1 <- ggplot() + geom_rect(data = clusters3.1,
    aes(xmin = lengthmin, xmax = lengthmax, ymin = ymin, ymax = ymax),
    fill = "blue", alpha = 0.1, color = "black"
  ) +
  labs(
    title = "Point clouds of centers and extremes",
    x = "Variable 1",
    y = "Y"
  ) +
  theme_minimal()

graf3.1 <- rectangulos3.1 + 
  geom_point(data = clusters3.1, 
    aes(x = lengthmin, y = ymin), 
    color = "green", size = 2, alpha = 0.9
  )+ geom_point(
    data = clusters2.1, 
    aes(x = lengthmax, y = ymax), 
    color = "red", size = 2, alpha = 0.9
  )+ 
  geom_point(
    data = clusters1.1, 
    aes(x = (lengthmin+lengthmax)/2, y = (ymin+ymax)/2), 
    color = "orange", size = 2, alpha = 0.9
  )

graf3.1

8.2.7 Gráfica final para la variable DIAMETER con el método de centros y rangos.

geom_indicesc <- indice1$results[[2]]$geom_indices #centros

geom_indicescmasr <- indice2$results[[2]]$geom_indices #centrosmasrangos
geom_indicescmasr1 <- geom_indicescmasr %>% group_by(alpha) %>% filter(geom_corr==max(geom_corr)) %>% ungroup() #Selección de los valores únicos de alpha, considerando el mínimo valor asociado en geom_corr
ggplot(geom_indicescmasr1, aes(x=alpha,y=geom_corr))+geom_point()

geom_indicescmenosr <- indice3$results[[2]]$geom_indices #centrosmenosrangos
geom_indicescmenosr1 <- geom_indicescmenosr %>% group_by(alpha) %>% filter(geom_corr==max(geom_corr)) %>% ungroup() #Selección de los valores únicos de alpha, considerando el máximo valor asociado en geom_corr
ggplot(geom_indicescmenosr1, aes(x=alpha,y=geom_corr))+geom_point()

# Etiquetas para identificar cada curva

geom_indicesc$label <- "centros"
geom_indicescmasr$label <- "centros más rangos"
geom_indicescmenosr$label <- "centros menos rangos"

# Combinar los datos
data_combined <- rbind(geom_indicesc,geom_indicescmasr, geom_indicescmenosr )
data_combined1 <- rbind(geom_indicescmasr1, geom_indicescmenosr1)

# Crear el gráfico
ggplotly(ggplot(data_combined, aes(x = alpha, y = geom_corr, color = label)) +
  geom_step(size = 1) +
  labs(
    title = "Correlación geométrica para la variable DIAMETER",
    x = "Alpha",
    y = "Geom_corr",
    color = "Curvas"
  ) +
  theme_minimal() +
  theme(legend.position = "bottom"))
library(pracma)

alpha.vals <- sort(unique(c(geom_indicescmasr1$alpha, geom_indicescmenosr1$alpha)))

geom_corr.cmasr <- approx(geom_indicescmasr1$alpha, geom_indicescmasr1$geom_corr, xout = alpha.vals, rule = 2)$y

geom_corr.cmenosr <- approx(geom_indicescmenosr1$alpha, geom_indicescmenosr1$geom_corr, xout = alpha.vals, rule = 2)$y

diff.geom_corr <- geom_corr.cmasr - geom_corr.cmenosr

table.cmasr <- cbind(alpha.vals, geom_corr.cmasr)
ggplot(table.cmasr, aes(x=alpha.vals, geom_corr.cmasr))+geom_point()

table.cmenosr <- cbind(alpha.vals, geom_corr.cmenosr)
ggplot(table.cmenosr, aes(x=alpha.vals, geom_corr.cmenosr))+geom_point()

table.diff <- cbind(alpha.vals, diff.geom_corr)
table.diff
##       alpha.vals diff.geom_corr
##  [1,] 0.01414214  -5.010507e-04
##  [2,] 0.02061553  -4.567734e-05
##  [3,] 0.02236068  -4.567734e-05
##  [4,] 0.02236068   1.411518e-03
##  [5,] 0.02500000   1.957966e-03
##  [6,] 0.02500000   3.141937e-03
##  [7,] 0.03162278   3.506235e-03
##  [8,] 0.03162278   3.870534e-03
##  [9,] 0.03162278   3.870534e-03
## [10,] 0.03354102   5.236654e-03
## [11,] 0.03535534   5.893799e-03
## [12,] 0.03605551   6.137749e-03
## [13,] 0.03605551   6.502047e-03
## [14,] 0.04031129   6.625529e-03
## [15,] 0.04031129   6.625529e-03
## [16,] 0.04123106   5.972963e-03
## [17,] 0.04472136   6.908696e-03
## [18,] 0.05000000   6.864848e-03
## [19,] 0.05315073   6.191568e-03
## [20,] 0.06020797   5.830334e-03
## [21,] 0.06184658   5.160336e-03
## [22,] 0.06324555   5.031947e-03
## [23,] 0.06403124   7.339810e-03
## [24,] 0.06576473   7.989346e-03
## [25,] 0.07071068   6.842667e-03
## [26,] 0.07648529   5.925128e-03
## [27,] 0.08000000   5.716900e-03
## [28,] 0.08062258   5.481027e-03
## [29,] 0.08246211   4.802202e-03
## [30,] 0.08845903   3.382224e-03
## [31,] 0.08860023   7.694121e-03
## [32,] 0.09013878   7.944798e-03
## [33,] 0.09055385   7.368050e-03
## [34,] 0.09219544   8.056195e-03
## [35,] 0.09513149   8.818497e-03
## [36,] 0.09617692   9.029980e-03
## [37,] 0.09708244   7.937025e-03
## [38,] 0.09823441   8.433267e-03
## [39,] 0.10688779   9.048712e-03
## [40,] 0.10770330   7.136662e-03
## [41,] 0.11011358   6.400595e-03
## [42,] 0.11101802   6.303947e-03
## [43,] 0.12257651   9.113461e-03
## [44,] 0.12539936   8.407843e-03
## [45,] 0.12747549   8.599094e-03
## [46,] 0.13583078   8.581774e-03
## [47,] 0.14849242   1.020693e-02
## [48,] 0.15000000   1.041223e-02
## [49,] 0.17029386   1.228544e-02
## [50,] 0.17117243   1.034592e-02
## [51,] 0.17182840   8.070621e-03
## [52,] 0.20000000   1.324926e-02
## [53,] 0.22022716   1.688006e-02
## [54,] 0.23021729   1.902845e-02
## [55,] 0.23632605   4.224508e-02
## [56,] 0.23690715   4.435955e-02
## [57,] 0.24253866   5.200286e-02
## [58,] 0.24682990   5.182597e-02
## [59,] 0.26800187   5.372343e-02
## [60,] 0.27771388   4.965851e-02
## [61,] 0.29652150   5.272071e-02
## [62,] 0.29920729   5.267673e-02
## [63,] 0.31184932   5.238803e-02
## [64,] 0.31894357   5.227292e-02
## [65,] 0.34179672   7.759101e-02
## [66,] 0.35106979   8.887216e-02
## [67,] 0.46671726   1.219334e-01
## [68,] 0.64352545   1.702145e-01
## [69,] 0.69146583   1.654053e-01
## [70,] 0.72292807   1.623309e-01
## [71,] 1.06303810   1.217147e-01
## [72,] 1.35875862   8.594917e-02
ggplot(table.diff, aes(x=alpha.vals, diff.geom_corr))+geom_point()

area.acumulada <- cumsum(c(0, diff.geom_corr[-1] * diff(alpha.vals))) #analizar esto
area.acumulada
##  [1]  0.000000e+00 -2.956874e-07 -3.754012e-07 -3.754012e-07  4.792297e-06
##  [6]  4.792297e-06  2.801331e-05  2.801331e-05  2.801331e-05  3.805849e-05
## [11]  4.875172e-05  5.304921e-05  5.304921e-05  8.124598e-05  8.124598e-05
## [16]  8.673971e-05  1.108532e-04  1.470902e-04  1.665982e-04  2.077443e-04
## [21]  2.162000e-04  2.232396e-04  2.290064e-04  2.428558e-04  2.766993e-04
## [26]  3.109146e-04  3.310079e-04  3.344202e-04  3.432541e-04  3.635370e-04
## [31]  3.646233e-04  3.768469e-04  3.799051e-04  3.931301e-04  4.190216e-04
## [36]  4.284618e-04  4.356490e-04  4.453639e-04  5.236658e-04  5.294858e-04
## [41]  5.449130e-04  5.506146e-04  6.559524e-04  6.796865e-04  6.975393e-04
## [46]  7.692425e-04  8.984790e-04  9.141762e-04  1.163495e-03  1.172585e-03
## [51]  1.177879e-03  1.551132e-03  1.892567e-03  2.082664e-03  2.340729e-03
## [56]  2.366507e-03  2.659361e-03  2.881759e-03  4.019189e-03  4.501474e-03
## [61]  5.493025e-03  5.634503e-03  6.296794e-03  6.667631e-03  8.440831e-03
## [66]  9.264949e-03  2.336624e-02  5.346155e-02  6.139115e-02  6.649844e-02
## [71]  1.078948e-01  1.333118e-01
data.acumulada <- data.frame(alpha = alpha.vals, area = area.acumulada)
data.acumulada
##         alpha          area
## 1  0.01414214  0.000000e+00
## 2  0.02061553 -2.956874e-07
## 3  0.02236068 -3.754012e-07
## 4  0.02236068 -3.754012e-07
## 5  0.02500000  4.792297e-06
## 6  0.02500000  4.792297e-06
## 7  0.03162278  2.801331e-05
## 8  0.03162278  2.801331e-05
## 9  0.03162278  2.801331e-05
## 10 0.03354102  3.805849e-05
## 11 0.03535534  4.875172e-05
## 12 0.03605551  5.304921e-05
## 13 0.03605551  5.304921e-05
## 14 0.04031129  8.124598e-05
## 15 0.04031129  8.124598e-05
## 16 0.04123106  8.673971e-05
## 17 0.04472136  1.108532e-04
## 18 0.05000000  1.470902e-04
## 19 0.05315073  1.665982e-04
## 20 0.06020797  2.077443e-04
## 21 0.06184658  2.162000e-04
## 22 0.06324555  2.232396e-04
## 23 0.06403124  2.290064e-04
## 24 0.06576473  2.428558e-04
## 25 0.07071068  2.766993e-04
## 26 0.07648529  3.109146e-04
## 27 0.08000000  3.310079e-04
## 28 0.08062258  3.344202e-04
## 29 0.08246211  3.432541e-04
## 30 0.08845903  3.635370e-04
## 31 0.08860023  3.646233e-04
## 32 0.09013878  3.768469e-04
## 33 0.09055385  3.799051e-04
## 34 0.09219544  3.931301e-04
## 35 0.09513149  4.190216e-04
## 36 0.09617692  4.284618e-04
## 37 0.09708244  4.356490e-04
## 38 0.09823441  4.453639e-04
## 39 0.10688779  5.236658e-04
## 40 0.10770330  5.294858e-04
## 41 0.11011358  5.449130e-04
## 42 0.11101802  5.506146e-04
## 43 0.12257651  6.559524e-04
## 44 0.12539936  6.796865e-04
## 45 0.12747549  6.975393e-04
## 46 0.13583078  7.692425e-04
## 47 0.14849242  8.984790e-04
## 48 0.15000000  9.141762e-04
## 49 0.17029386  1.163495e-03
## 50 0.17117243  1.172585e-03
## 51 0.17182840  1.177879e-03
## 52 0.20000000  1.551132e-03
## 53 0.22022716  1.892567e-03
## 54 0.23021729  2.082664e-03
## 55 0.23632605  2.340729e-03
## 56 0.23690715  2.366507e-03
## 57 0.24253866  2.659361e-03
## 58 0.24682990  2.881759e-03
## 59 0.26800187  4.019189e-03
## 60 0.27771388  4.501474e-03
## 61 0.29652150  5.493025e-03
## 62 0.29920729  5.634503e-03
## 63 0.31184932  6.296794e-03
## 64 0.31894357  6.667631e-03
## 65 0.34179672  8.440831e-03
## 66 0.35106979  9.264949e-03
## 67 0.46671726  2.336624e-02
## 68 0.64352545  5.346155e-02
## 69 0.69146583  6.139115e-02
## 70 0.72292807  6.649844e-02
## 71 1.06303810  1.078948e-01
## 72 1.35875862  1.333118e-01
p <- ggplot(data.acumulada, aes(x = alpha, y = area.acumulada)) +
  geom_line(size = 1, color = "blue") +
  labs(
    title = "Área Acumulada entre las Curvas",
    x = "Alpha",
    y = "Área Acumulada"
  ) +
  theme_minimal()

ggplotly(p)
#Derivada.

tasa.cambio <- diff(area.acumulada) / diff(alpha.vals)
alpha.medios <- (alpha.vals[-1] + alpha.vals[-length(alpha.vals)])/2
data.derivada <- data.frame(alpha = alpha.medios, tasadecambio = tasa.cambio)

p.derivada <- ggplot(data.derivada, aes(x = alpha, y = tasa.cambio)) +
  geom_line(size = 1, color = "red") +
  labs(
    title = "Tasa de Cambio de la Función Acumulada",
    x = "Alpha",
    y = "Derivada (Tasa de Cambio)"
  ) +
  theme_minimal()

ggplotly(p.derivada)

8.2.8 Contribución de la variable HEIGHT al modelo de centros.

data.c1 <- cbind(data.c[,-4],Y.c) 
ggplot(data.c1, aes(x = HEIGHT, y = Y.c))+geom_point()+labs(title = "HEIGHT vs. Y") 

Lo que se está haciendo en realidad es tomar los centros de las observaciones de cada variable predictora como representantes de cada rectángulo de la agrupación rectangular formada por la variable predictora y la variable dependiente del modelo de regresión.

Gráficamente:

height1 <- data.frame(lengthmin=c(0.07,0.02,0.06,0.10,0.10,0.14,0.12,0.18,0.01,0.00,0.00,0.08,0.08,0.12,0.12,0.04,0.02,0.04,0.06,0.08,0.12,0.13,0.14,0.20),lengthmax=c(0.18,1.13,0.23,0.25,0.24,0.22,0.21,0.22,0.06,0.15,0.18,0.19,0.22,0.20,0.18,0.05,0.16,0.20,0.52,0.24,0.24,0.23,0.22,0.22)) #variable HEIGHT

clusters1.2 <- cbind(height1,ypred1$Fitted)
colnames(clusters1.2) <- c('lengthmin','lengthmax','ymin','ymax')
rectangulos1.2 <- ggplot() + geom_rect(data = clusters1.2,
    aes(xmin = lengthmin, xmax = lengthmax, ymin = ymin, ymax = ymax),
    fill = "blue", alpha = 0.2, color = "black"
  ) +
  labs(
    title = "Centers for the variable HEIGHT",
    x = "HEIGHT",
    y = "Y"
  ) +
  theme_minimal()

graf1.2 <- rectangulos1.2 + 
  geom_point(
    data = clusters1.2, 
    aes(x = (lengthmin+lengthmax)/2, y = (ymin+ymax)/2), 
    color = "orange", size = 2, alpha = 0.9
  )

graf1.2 

8.2.9 Contribución de la variable HEIGHT al modelo de centros más rangos.

data.cmasr1 <- cbind(data.cmasr[,-4],Y.cmasr)
ggplot(data.cmasr1, aes(x = HEIGHT, y = Y.cmasr))+geom_point()+labs(title = "HEIGHT vs. Y") 

clusters2.2 <- cbind(height1,ypred2$Fitted)
colnames(clusters2.2) <- c('lengthmin','lengthmax','ymin','ymax')

rectangulos2.2 <- ggplot() + geom_rect(data = clusters2.2,
    aes(xmin = lengthmin, xmax = lengthmax, ymin = ymin, ymax = ymax),
    fill = "blue", alpha = 0.1, color = "black"
  ) +
  labs(
    title = "Centers plus ranges for the variable HEIGHT", x="HEIGHT",
    y = "Y"
  ) +
  theme_minimal()

graf2.2 <- rectangulos2.2 + 
  geom_point(
    data = clusters2.2, 
    aes(x = lengthmax, y = ymax), 
    color = "red", size = 3, alpha = 0.9
  )

graf2.2

8.2.10 Contribución de la variable HEIGHT al modelo de centros menos rangos.

data.cmenosr1 <- cbind(data.cmenosr[,-4],Y.cmenosr)
ggplot(data.cmenosr1, aes(x = HEIGHT, y = Y.cmenosr))+geom_point()+labs(title = "DIAMETER vs. Y") 

clusters3.2 <- cbind(height1,ypred3$Fitted)
colnames(clusters3.2) <- c('lengthmin','lengthmax','ymin','ymax')

rectangulos3.2 <- ggplot() + geom_rect(data = clusters3.2,
    aes(xmin = lengthmin, xmax = lengthmax, ymin = ymin, ymax = ymax),
    fill = "blue", alpha = 0.1, color = "black"
  ) +
  labs(
    title = "Centers minus ranges for the variable HEIGHT",
    x = "HEIGHT",
    y = "Y"
  ) +
  theme_minimal()

graf3.2 <- rectangulos3.2 + 
  geom_point(data = clusters3.2, 
    aes(x = lengthmin, y = ymin), 
    color = "green", size = 3, alpha = 0.9
  )

graf3.2

8.2.11 Gráfica final para la variable HEIGHT con el método de centros y rangos.

geom_indicesc <- indice1$results[[3]]$geom_indices #centros

geom_indicescmasr <- indice2$results[[3]]$geom_indices #centrosmasrangos
geom_indicescmasr1 <- geom_indicescmasr %>% group_by(alpha) %>% filter(geom_corr==max(geom_corr)) %>% ungroup() #Selección de los valores únicos de alpha, considerando el mínimo valor asociado en geom_corr
ggplot(geom_indicescmasr1, aes(x=alpha,y=geom_corr))+geom_point()

geom_indicescmenosr <- indice3$results[[3]]$geom_indices #centrosmenosrangos
geom_indicescmenosr1 <- geom_indicescmenosr %>% group_by(alpha) %>% filter(geom_corr==max(geom_corr)) %>% ungroup() #Selección de los valores únicos de alpha, considerando el máximo valor asociado en geom_corr
ggplot(geom_indicescmenosr1, aes(x=alpha,y=geom_corr))+geom_point()

# Etiquetas para identificar cada curva

geom_indicesc$label <- "centros"
geom_indicescmasr$label <- "centros más rangos"
geom_indicescmenosr$label <- "centros menos rangos"

# Combinar los datos
data_combined <- rbind(geom_indicesc,geom_indicescmasr, geom_indicescmenosr )
data_combined1 <- rbind(geom_indicescmasr1, geom_indicescmenosr1)

# Crear el gráfico
ggplotly(ggplot(data_combined, aes(x = alpha, y = geom_corr, color = label)) +
  geom_step(size = 1) +
  labs(
    title = "Correlación geométrica para la variable HEIGHT",
    x = "Alpha",
    y = "Geom_corr",
    color = "Curvas"
  ) +
  theme_minimal() +
  theme(legend.position = "bottom"))
library(pracma)

alpha.vals <- sort(unique(c(geom_indicescmasr1$alpha, geom_indicescmenosr1$alpha)))

geom_corr.cmasr <- approx(geom_indicescmasr1$alpha, geom_indicescmasr1$geom_corr, xout = alpha.vals, rule = 2)$y

geom_corr.cmenosr <- approx(geom_indicescmenosr1$alpha, geom_indicescmenosr1$geom_corr, xout = alpha.vals, rule = 2)$y

diff.geom_corr <- geom_corr.cmasr - geom_corr.cmenosr

table.cmasr <- cbind(alpha.vals, geom_corr.cmasr)
ggplot(table.cmasr, aes(x=alpha.vals, geom_corr.cmasr))+geom_point()

table.cmenosr <- cbind(alpha.vals, geom_corr.cmenosr)
ggplot(table.cmenosr, aes(x=alpha.vals, geom_corr.cmenosr))+geom_point()

table.diff <- cbind(alpha.vals, diff.geom_corr)
table.diff
##       alpha.vals diff.geom_corr
##  [1,] 0.01414214   0.0007228854
##  [2,] 0.01500000   0.0019523936
##  [3,] 0.02000000   0.0019523936
##  [4,] 0.02061553   0.0027720658
##  [5,] 0.02061553   0.0035917379
##  [6,] 0.02236068   0.0048212461
##  [7,] 0.02500000   0.0056409182
##  [8,] 0.02692582   0.0073093740
##  [9,] 0.03162278   0.0113322618
## [10,] 0.03162278   0.0129716061
## [11,] 0.03162278   0.0129716061
## [12,] 0.03500000   0.0186759760
## [13,] 0.03535534   0.0203118129
## [14,] 0.03640055   0.0280883814
## [15,] 0.03807887   0.0372931270
## [16,] 0.04000000   0.0382732793
## [17,] 0.04031129   0.0383061208
## [18,] 0.04123106   0.0387814770
## [19,] 0.04609772   0.0451181535
## [20,] 0.06020797   0.0475314107
## [21,] 0.06020797   0.0475314107
## [22,] 0.06324555   0.0501857712
## [23,] 0.06576473   0.0524705353
## [24,] 0.07071068   0.0527812704
## [25,] 0.07566373   0.0529299117
## [26,] 0.07648529   0.0529920638
## [27,] 0.08062258   0.0561948328
## [28,] 0.08631338   0.0607669036
## [29,] 0.09055385   0.0617632425
## [30,] 0.09552487   0.0626457139
## [31,] 0.10111874   0.0648797609
## [32,] 0.10198039   0.0649591454
## [33,] 0.10511898   0.0651813762
## [34,] 0.10606602   0.0655987524
## [35,] 0.11011358   0.0662024758
## [36,] 0.11543396   0.0670859265
## [37,] 0.12093387   0.0674891073
## [38,] 0.12539936   0.0676579870
## [39,] 0.12589678   0.0700949015
## [40,] 0.12816006   0.0865926981
## [41,] 0.13509256   0.0874349083
## [42,] 0.15033296   0.0897377629
## [43,] 0.17334936   0.0932501557
## [44,] 0.17507141   0.0913904413
## [45,] 0.18027756   0.0915444775
## [46,] 0.18560711   0.0917189880
## [47,] 0.19448650   0.0895788887
## [48,] 0.20886599   0.0901580500
## [49,] 0.21708293   0.0905918177
## [50,] 0.23584953   0.1208457877
## [51,] 0.25223997   0.1503439841
## [52,] 0.26076810   0.1521643056
## [53,] 0.31184932   0.1672753412
## [54,] 0.33000000   0.1745228845
## [55,] 0.34234486   0.1795039584
## [56,] 0.45024993   0.2163580680
## [57,] 0.45400991   0.1464426057
## [58,] 0.46010868   0.1191031189
## [59,] 0.46270941   0.0942506732
## [60,] 0.47055818   0.0887193863
## [61,] 0.50982840   0.0708803823
## [62,] 0.53956001   0.0642094976
## [63,] 0.54664888   0.0655506576
## [64,] 0.56678920   0.0656735804
## [65,] 0.57212324   0.0659928611
## [66,] 0.59076222   0.0636600651
## [67,] 0.61459336   0.0380438565
## [68,] 0.63780875   0.0301073486
## [69,] 0.76134749  -0.0254482070
## [70,] 0.82602966  -0.0411437806
## [71,] 1.21652168  -0.1599333018
## [72,] 1.24788822  -0.1631272623
ggplot(table.diff, aes(x=alpha.vals, diff.geom_corr))+geom_point()

area.acumulada <- cumsum(c(0, diff.geom_corr[-1] * diff(alpha.vals))) #analizar esto
area.acumulada
##  [1]  0.000000e+00  1.674889e-06  1.143686e-05  1.314314e-05  1.314314e-05
##  [6]  2.155695e-05  3.644514e-05  5.052171e-05  1.037488e-04  1.037488e-04
## [11]  1.037488e-04  1.668217e-04  1.740393e-04  2.033976e-04  2.659872e-04
## [16]  3.395154e-04  3.514396e-04  3.871096e-04  6.066846e-04  1.277365e-03
## [21]  1.277365e-03  1.429808e-03  1.561991e-03  1.823044e-03  2.085209e-03
## [26]  2.128745e-03  2.361239e-03  2.707051e-03  2.968957e-03  3.280369e-03
## [31]  3.643299e-03  3.699271e-03  3.903848e-03  3.965973e-03  4.233931e-03
## [36]  4.590854e-03  4.962038e-03  5.264164e-03  5.299031e-03  5.495014e-03
## [41]  6.101157e-03  7.468796e-03  9.615079e-03  9.772458e-03  1.024905e-02
## [46]  1.073787e-02  1.153328e-02  1.282971e-02  1.357409e-02  1.584196e-02
## [51]  1.830616e-02  1.960384e-02  2.814847e-02  3.131618e-02  3.353213e-02
## [56]  5.687826e-02  5.742888e-02  5.815526e-02  5.840038e-02  5.909672e-02
## [61]  6.188021e-02  6.378926e-02  6.425394e-02  6.557663e-02  6.592864e-02
## [66]  6.711520e-02  6.802183e-02  6.872078e-02  6.557694e-02  6.291567e-02
## [71]  4.629927e-04 -4.653744e-03
data.acumulada <- data.frame(alpha = alpha.vals, area = area.acumulada)
data.acumulada
##         alpha          area
## 1  0.01414214  0.000000e+00
## 2  0.01500000  1.674889e-06
## 3  0.02000000  1.143686e-05
## 4  0.02061553  1.314314e-05
## 5  0.02061553  1.314314e-05
## 6  0.02236068  2.155695e-05
## 7  0.02500000  3.644514e-05
## 8  0.02692582  5.052171e-05
## 9  0.03162278  1.037488e-04
## 10 0.03162278  1.037488e-04
## 11 0.03162278  1.037488e-04
## 12 0.03500000  1.668217e-04
## 13 0.03535534  1.740393e-04
## 14 0.03640055  2.033976e-04
## 15 0.03807887  2.659872e-04
## 16 0.04000000  3.395154e-04
## 17 0.04031129  3.514396e-04
## 18 0.04123106  3.871096e-04
## 19 0.04609772  6.066846e-04
## 20 0.06020797  1.277365e-03
## 21 0.06020797  1.277365e-03
## 22 0.06324555  1.429808e-03
## 23 0.06576473  1.561991e-03
## 24 0.07071068  1.823044e-03
## 25 0.07566373  2.085209e-03
## 26 0.07648529  2.128745e-03
## 27 0.08062258  2.361239e-03
## 28 0.08631338  2.707051e-03
## 29 0.09055385  2.968957e-03
## 30 0.09552487  3.280369e-03
## 31 0.10111874  3.643299e-03
## 32 0.10198039  3.699271e-03
## 33 0.10511898  3.903848e-03
## 34 0.10606602  3.965973e-03
## 35 0.11011358  4.233931e-03
## 36 0.11543396  4.590854e-03
## 37 0.12093387  4.962038e-03
## 38 0.12539936  5.264164e-03
## 39 0.12589678  5.299031e-03
## 40 0.12816006  5.495014e-03
## 41 0.13509256  6.101157e-03
## 42 0.15033296  7.468796e-03
## 43 0.17334936  9.615079e-03
## 44 0.17507141  9.772458e-03
## 45 0.18027756  1.024905e-02
## 46 0.18560711  1.073787e-02
## 47 0.19448650  1.153328e-02
## 48 0.20886599  1.282971e-02
## 49 0.21708293  1.357409e-02
## 50 0.23584953  1.584196e-02
## 51 0.25223997  1.830616e-02
## 52 0.26076810  1.960384e-02
## 53 0.31184932  2.814847e-02
## 54 0.33000000  3.131618e-02
## 55 0.34234486  3.353213e-02
## 56 0.45024993  5.687826e-02
## 57 0.45400991  5.742888e-02
## 58 0.46010868  5.815526e-02
## 59 0.46270941  5.840038e-02
## 60 0.47055818  5.909672e-02
## 61 0.50982840  6.188021e-02
## 62 0.53956001  6.378926e-02
## 63 0.54664888  6.425394e-02
## 64 0.56678920  6.557663e-02
## 65 0.57212324  6.592864e-02
## 66 0.59076222  6.711520e-02
## 67 0.61459336  6.802183e-02
## 68 0.63780875  6.872078e-02
## 69 0.76134749  6.557694e-02
## 70 0.82602966  6.291567e-02
## 71 1.21652168  4.629927e-04
## 72 1.24788822 -4.653744e-03
p <- ggplot(data.acumulada, aes(x = alpha, y = area.acumulada)) +
  geom_line(size = 1, color = "blue") +
  labs(
    title = "Área Acumulada entre las Curvas",
    x = "Alpha",
    y = "Área Acumulada"
  ) +
  theme_minimal()

ggplotly(p)
#Derivada.

tasa.cambio <- diff(area.acumulada) / diff(alpha.vals)
alpha.medios <- (alpha.vals[-1] + alpha.vals[-length(alpha.vals)])/2
data.derivada <- data.frame(alpha = alpha.medios, tasadecambio = tasa.cambio)

p.derivada <- ggplot(data.derivada, aes(x = alpha, y = tasa.cambio)) +
  geom_line(size = 1, color = "red") +
  labs(
    title = "Tasa de Cambio de la Función Acumulada",
    x = "Alpha",
    y = "Derivada (Tasa de Cambio)"
  ) +
  theme_minimal() 

ggplotly(p.derivada) 
# Esta curva coincide con la nube de puntos de las diferencias, puesto que es la derivada de la curva obtenida con integración. El máximo alpha obtenido es 0.39

8.2.12 Contribución de la variable SHUCKED_WEIGHT al modelo de centros.

data.c1 <- cbind(data.c[,-4],Y.c) 
ggplot(data.c1, aes(x = SHUCKED_WEIGHT, y = Y.c))+geom_point()+labs(title = "SHUCKED_WEIGHT vs. Y") 

Lo que se está haciendo en realidad es tomar los centros de las observaciones de cada variable predictora como representantes de cada rectángulo de la agrupación rectangular formada por la variable predictora y la variable dependiente del modelo de regresión.

Gráficamente:

shucked_weight1 <- data.frame(lengthmin=c(0.03,0.06,0.07,0.11,0.12,0.16,0.16,0.32,0.00,0.00,0.03,0.06,0.07,0.16,0.11,0.01,0.01,0.02,0.04,0.10,0.11,0.22,0.25,0.38),lengthmax=c(0.64,1.16,1.49,1.23,0.84,0.93,0.82,0.71,0.03,0.50,0.60,0.72,0.77,0.63,0.39,0.02,0.32,1.25,1.35,1.35,1.15,0.87,0.74,0.75)) #variable SHUCKED_WEIGHT

clusters1.3 <- cbind(shucked_weight1,ypred1$Fitted)
colnames(clusters1.3) <- c('lengthmin','lengthmax','ymin','ymax')
rectangulos1.3 <- ggplot() + geom_rect(data = clusters1.3,
    aes(xmin = lengthmin, xmax = lengthmax, ymin = ymin, ymax = ymax),
    fill = "blue", alpha = 0.2, color = "black"
  ) +
  labs(
    title = "Centers for the variable HEIGHT",
    x = "HEIGHT",
    y = "Y"
  ) +
  theme_minimal()

graf1.3 <- rectangulos1.3 + 
  geom_point(
    data = clusters1.3, 
    aes(x = (lengthmin+lengthmax)/2, y = (ymin+ymax)/2), 
    color = "orange", size = 2, alpha = 0.9
  )

graf1.3

8.2.13 Contribución de la variable SHUCKED_WEIGHT al modelo de centros más rangos.

data.cmasr1 <- cbind(data.cmasr[,-4],Y.cmasr)
ggplot(data.cmasr1, aes(x = SHUCKED_WEIGHT, y = Y.cmasr))+geom_point()+labs(title = "SHUCKED_WEIGHT vs. Y") 

clusters2.3 <- cbind(shucked_weight1,ypred2$Fitted)
colnames(clusters2.3) <- c('lengthmin','lengthmax','ymin','ymax')

rectangulos2.3 <- ggplot() + geom_rect(data = clusters2.3,
    aes(xmin = lengthmin, xmax = lengthmax, ymin = ymin, ymax = ymax),
    fill = "blue", alpha = 0.1, color = "black"
  ) +
  labs(
    title = "Centers plus ranges for the variable SHUCKED_WEIGHT ", x="SHUCKED_WEIGHT",
    y = "Y"
  ) +
  theme_minimal()

graf2.3 <- rectangulos2.3 + 
  geom_point(
    data = clusters2.3, 
    aes(x = lengthmax, y = ymax), 
    color = "red", size = 3, alpha = 0.9
  )

graf2.3

8.2.14 Contribución de la variable SHUCKED_WEIGHT al modelo de centros menos rangos.

data.cmenosr1 <- cbind(data.cmenosr[,-4],Y.cmenosr)
ggplot(data.cmenosr1, aes(x = SHUCKED_WEIGHT, y = Y.cmenosr))+geom_point()+labs(title = "SHUCKED_WEIGHT vs. Y") 

clusters3.3 <- cbind(shucked_weight1,ypred3$Fitted)
colnames(clusters3.3) <- c('lengthmin','lengthmax','ymin','ymax')

rectangulos3.3 <- ggplot() + geom_rect(data = clusters3.3,
    aes(xmin = lengthmin, xmax = lengthmax, ymin = ymin, ymax = ymax),
    fill = "blue", alpha = 0.1, color = "black"
  ) +
  labs(
    title = "Centers minus ranges for the variable SHUCKED_WEIGHT ",
    x = "SHUCKED_WEIGHT",
    y = "Y"
  ) +
  theme_minimal()

graf3.3 <- rectangulos3.3 + 
  geom_point(data = clusters3.3, 
    aes(x = lengthmin, y = ymin), 
    color = "green", size = 3, alpha = 0.9
  )

graf3.3

8.2.15 Gráfica final para la variable SHUCKED_WEIGHT con el método de centros y rangos.

geom_indicesc <- indice1$results[[4]]$geom_indices #centros

geom_indicescmasr <- indice2$results[[4]]$geom_indices #centrosmasrangos
geom_indicescmasr1 <- geom_indicescmasr %>% group_by(alpha) %>% filter(geom_corr==max(geom_corr)) %>% ungroup() #Selección de los valores únicos de alpha, considerando el mínimo valor asociado en geom_corr
ggplot(geom_indicescmasr1, aes(x=alpha,y=geom_corr))+geom_point()

geom_indicescmenosr <- indice3$results[[4]]$geom_indices #centrosmenosrangos
geom_indicescmenosr1 <- geom_indicescmenosr %>% group_by(alpha) %>% filter(geom_corr==max(geom_corr)) %>% ungroup() #Selección de los valores únicos de alpha, considerando el máximo valor asociado en geom_corr
ggplot(geom_indicescmenosr1, aes(x=alpha,y=geom_corr))+geom_point()

# Etiquetas para identificar cada curva

geom_indicesc$label <- "centros"
geom_indicescmasr$label <- "centros más rangos"
geom_indicescmenosr$label <- "centros menos rangos"

# Combinar los datos
data_combined <- rbind(geom_indicesc,geom_indicescmasr, geom_indicescmenosr )
data_combined1 <- rbind(geom_indicescmasr1, geom_indicescmenosr1)

# Crear el gráfico
ggplotly(ggplot(data_combined, aes(x = alpha, y = geom_corr, color = label)) +
  geom_step(size = 1) +
  labs(
    title = "Correlación geométrica para la variable SHUCKED_WEIGHT",
    x = "Alpha",
    y = "Geom_corr",
    color = "Curvas"
  ) +
  theme_minimal() +
  theme(legend.position = "bottom"))
library(pracma)

alpha.vals <- sort(unique(c(geom_indicescmasr1$alpha, geom_indicescmenosr1$alpha)))

geom_corr.cmasr <- approx(geom_indicescmasr1$alpha, geom_indicescmasr1$geom_corr, xout = alpha.vals, rule = 2)$y

geom_corr.cmenosr <- approx(geom_indicescmenosr1$alpha, geom_indicescmenosr1$geom_corr, xout = alpha.vals, rule = 2)$y

diff.geom_corr <- geom_corr.cmasr - geom_corr.cmenosr

table.cmasr <- cbind(alpha.vals, geom_corr.cmasr)
ggplot(table.cmasr, aes(x=alpha.vals, geom_corr.cmasr))+geom_point()

table.cmenosr <- cbind(alpha.vals, geom_corr.cmenosr)
ggplot(table.cmenosr, aes(x=alpha.vals, geom_corr.cmenosr))+geom_point()

table.diff <- cbind(alpha.vals, diff.geom_corr)
table.diff
##       alpha.vals diff.geom_corr
##  [1,] 0.01118034  -6.056878e-05
##  [2,] 0.01118034   1.496036e-04
##  [3,] 0.01581139   4.648621e-04
##  [4,] 0.02061553   8.852068e-04
##  [5,] 0.02236068   1.095379e-03
##  [6,] 0.02500000   2.356413e-03
##  [7,] 0.02828427   3.617447e-03
##  [8,] 0.03041381   4.247964e-03
##  [9,] 0.03201562   6.980205e-03
## [10,] 0.03640055   7.610722e-03
## [11,] 0.03640055   8.031066e-03
## [12,] 0.03640055   8.031066e-03
## [13,] 0.03807887   8.136153e-03
## [14,] 0.04031129   8.661583e-03
## [15,] 0.04031129   9.081928e-03
## [16,] 0.04272002   9.607359e-03
## [17,] 0.04272002   9.607359e-03
## [18,] 0.04924429   1.065822e-02
## [19,] 0.05220153   1.089162e-02
## [20,] 0.05590170   1.071911e-02
## [21,] 0.05852350   1.123065e-02
## [22,] 0.06082763   1.114648e-02
## [23,] 0.06324555   1.130882e-02
## [24,] 0.06519202   1.263236e-02
## [25,] 0.07158911   1.331490e-02
## [26,] 0.07500000   1.323167e-02
## [27,] 0.07905694   1.786537e-02
## [28,] 0.08062258   2.855482e-02
## [29,] 0.08544004   3.174775e-02
## [30,] 0.08732125   3.311988e-02
## [31,] 0.09823441   4.825552e-02
## [32,] 0.09962429   4.866091e-02
## [33,] 0.10124228   6.144676e-02
## [34,] 0.10547512   6.159465e-02
## [35,] 0.10700467   6.074432e-02
## [36,] 0.11101802   5.880626e-02
## [37,] 0.11423660   5.785719e-02
## [38,] 0.11672618   5.934314e-02
## [39,] 0.11800424   5.890536e-02
## [40,] 0.12649111   5.811779e-02
## [41,] 0.13509256   5.768003e-02
## [42,] 0.14534442   5.560988e-02
## [43,] 0.14773287   5.278407e-02
## [44,] 0.15231546   5.067310e-02
## [45,] 0.15508062   4.303702e-02
## [46,] 0.16807736   3.837919e-02
## [47,] 0.17528548   3.217680e-02
## [48,] 0.17585505   2.419068e-02
## [49,] 0.17951323   2.276585e-02
## [50,] 0.18027756   2.248352e-02
## [51,] 0.18445867   2.089791e-02
## [52,] 0.19300259   1.707275e-02
## [53,] 0.20081086   1.635015e-02
## [54,] 0.20892582   1.740634e-02
## [55,] 0.21708293   1.600091e-02
## [56,] 0.22051077   2.126034e-02
## [57,] 0.23264780   4.280093e-02
## [58,] 0.23837995   5.320202e-02
## [59,] 0.24382371   6.146205e-02
## [60,] 0.24824383   6.883527e-02
## [61,] 0.30269622   9.753402e-02
## [62,] 0.30700163   9.446121e-02
## [63,] 0.30809901   9.303622e-02
## [64,] 0.33678628   8.478450e-02
## [65,] 0.37202150   7.965219e-02
## [66,] 0.42323162   7.640330e-02
## [67,] 0.54362211   6.764541e-02
## [68,] 0.54555018   6.349012e-02
## [69,] 0.58234440   5.344916e-02
## [70,] 0.61386073   5.271933e-02
## [71,] 0.62325757   5.016495e-02
## [72,] 0.70178344   4.595081e-02
## [73,] 0.79851425   4.113632e-02
## [74,] 1.31088710   6.716886e-03
## [75,] 1.53075145  -4.536528e-03
ggplot(table.diff, aes(x=alpha.vals, diff.geom_corr))+geom_point()

area.acumulada <- cumsum(c(0, diff.geom_corr[-1] * diff(alpha.vals))) #analizar esto
area.acumulada
##  [1] 0.000000e+00 2.595208e-22 2.152799e-06 6.405456e-06 8.317058e-06
##  [6] 1.453639e-05 2.641707e-05 3.546328e-05 4.664423e-05 8.001670e-05
## [11] 8.001670e-05 8.001670e-05 9.367174e-05 1.130081e-04 1.130081e-04
## [16] 1.361496e-04 1.361496e-04 2.056867e-04 2.378959e-04 2.775584e-04
## [21] 3.070029e-04 3.326858e-04 3.600297e-04 3.846182e-04 4.697947e-04
## [26] 5.149266e-04 5.874053e-04 6.321118e-04 7.850553e-04 8.473607e-04
## [31] 1.373981e-03 1.441614e-03 1.541034e-03 1.801754e-03 1.894666e-03
## [36] 2.130676e-03 2.316894e-03 2.464633e-03 2.539918e-03 3.033156e-03
## [41] 3.529288e-03 4.099393e-03 4.225465e-03 4.457679e-03 4.576683e-03
## [46] 5.075488e-03 5.307422e-03 5.321200e-03 5.404482e-03 5.421667e-03
## [51] 5.509043e-03 5.654911e-03 5.782578e-03 5.923829e-03 6.054351e-03
## [56] 6.127228e-03 6.646704e-03 6.951666e-03 7.286250e-03 7.590511e-03
## [61] 1.290147e-02 1.330817e-02 1.341026e-02 1.584250e-02 1.864906e-02
## [66] 2.256168e-02 3.070555e-02 3.082796e-02 3.279458e-02 3.445610e-02
## [71] 3.492749e-02 3.853582e-02 4.251497e-02 4.595652e-02 4.495910e-02
data.acumulada <- data.frame(alpha = alpha.vals, area = area.acumulada)
data.acumulada
##         alpha         area
## 1  0.01118034 0.000000e+00
## 2  0.01118034 2.595208e-22
## 3  0.01581139 2.152799e-06
## 4  0.02061553 6.405456e-06
## 5  0.02236068 8.317058e-06
## 6  0.02500000 1.453639e-05
## 7  0.02828427 2.641707e-05
## 8  0.03041381 3.546328e-05
## 9  0.03201562 4.664423e-05
## 10 0.03640055 8.001670e-05
## 11 0.03640055 8.001670e-05
## 12 0.03640055 8.001670e-05
## 13 0.03807887 9.367174e-05
## 14 0.04031129 1.130081e-04
## 15 0.04031129 1.130081e-04
## 16 0.04272002 1.361496e-04
## 17 0.04272002 1.361496e-04
## 18 0.04924429 2.056867e-04
## 19 0.05220153 2.378959e-04
## 20 0.05590170 2.775584e-04
## 21 0.05852350 3.070029e-04
## 22 0.06082763 3.326858e-04
## 23 0.06324555 3.600297e-04
## 24 0.06519202 3.846182e-04
## 25 0.07158911 4.697947e-04
## 26 0.07500000 5.149266e-04
## 27 0.07905694 5.874053e-04
## 28 0.08062258 6.321118e-04
## 29 0.08544004 7.850553e-04
## 30 0.08732125 8.473607e-04
## 31 0.09823441 1.373981e-03
## 32 0.09962429 1.441614e-03
## 33 0.10124228 1.541034e-03
## 34 0.10547512 1.801754e-03
## 35 0.10700467 1.894666e-03
## 36 0.11101802 2.130676e-03
## 37 0.11423660 2.316894e-03
## 38 0.11672618 2.464633e-03
## 39 0.11800424 2.539918e-03
## 40 0.12649111 3.033156e-03
## 41 0.13509256 3.529288e-03
## 42 0.14534442 4.099393e-03
## 43 0.14773287 4.225465e-03
## 44 0.15231546 4.457679e-03
## 45 0.15508062 4.576683e-03
## 46 0.16807736 5.075488e-03
## 47 0.17528548 5.307422e-03
## 48 0.17585505 5.321200e-03
## 49 0.17951323 5.404482e-03
## 50 0.18027756 5.421667e-03
## 51 0.18445867 5.509043e-03
## 52 0.19300259 5.654911e-03
## 53 0.20081086 5.782578e-03
## 54 0.20892582 5.923829e-03
## 55 0.21708293 6.054351e-03
## 56 0.22051077 6.127228e-03
## 57 0.23264780 6.646704e-03
## 58 0.23837995 6.951666e-03
## 59 0.24382371 7.286250e-03
## 60 0.24824383 7.590511e-03
## 61 0.30269622 1.290147e-02
## 62 0.30700163 1.330817e-02
## 63 0.30809901 1.341026e-02
## 64 0.33678628 1.584250e-02
## 65 0.37202150 1.864906e-02
## 66 0.42323162 2.256168e-02
## 67 0.54362211 3.070555e-02
## 68 0.54555018 3.082796e-02
## 69 0.58234440 3.279458e-02
## 70 0.61386073 3.445610e-02
## 71 0.62325757 3.492749e-02
## 72 0.70178344 3.853582e-02
## 73 0.79851425 4.251497e-02
## 74 1.31088710 4.595652e-02
## 75 1.53075145 4.495910e-02
p <- ggplot(data.acumulada, aes(x = alpha, y = area.acumulada)) +
  geom_line(size = 1, color = "blue") +
  labs(
    title = "Área Acumulada entre las Curvas",
    x = "Alpha",
    y = "Área Acumulada"
  ) +
  theme_minimal()

ggplotly(p)
#Derivada.

tasa.cambio <- diff(area.acumulada) / diff(alpha.vals)
alpha.medios <- (alpha.vals[-1] + alpha.vals[-length(alpha.vals)])/2
data.derivada <- data.frame(alpha = alpha.medios, tasadecambio = tasa.cambio)

p.derivada <- ggplot(data.derivada, aes(x = alpha, y = tasa.cambio)) +
  geom_line(size = 1, color = "red") +
  labs(
    title = "Tasa de Cambio de la Función Acumulada",
    x = "Alpha",
    y = "Derivada (Tasa de Cambio)"
  ) +
  theme_minimal() 

ggplotly(p.derivada) 
# Esta curva coincide con la nube de puntos de las diferencias, puesto que es la derivada de la curva obtenida con integración. El máximo alpha obtenido es 0.39

HACER LO MISMO CON TODAS LAS OTRAS VARIABLES.

9 Ejemplo 2. Con la tabla de datos simbólica cardiologicalv2.

9.1 Método de centros.

Primero, se tiene una tabla de datos simbólica de tipo intervalo, por ejemplo cardiologicalv2 de RSDA.

Se obtiene la matriz de centros asociada.

data <- cardiologicalv2
data.c <- interval.centers(data) 

Sobre la matriz de centros se aplica un modelo de regresión lineal clásico. Supongamos que se aplica un modelo de regresión lineal tomando como variable de respuesta Pulse.

modelo.c <- lm(Pulse ~., data.c)

El modelo es: \(Y=43.9379 + 0.1635X_{1}+0.2109X_{2}-1.4132X_{3}+0.2019X_{4}\).

Y.c <- modelo.c$fitted.values 

Luego, se estudia la contribución de cada variable predictora al modelo a través del diagrama de dispersión asociado.

Para la variable Syst, se tiene la nube de puntos:

data.c1 <- cbind(data.c[,-1],Y.c) 
summary(data.c1)
##       Syst           Diast             Art1            Art2       
##  Min.   : 72.5   Min.   : 60.00   Min.   :2.500   Min.   : 3.500  
##  1st Qu.: 89.5   1st Qu.: 83.00   1st Qu.:5.000   1st Qu.: 4.500  
##  Median :107.0   Median : 86.25   Median :5.750   Median : 5.000  
##  Mean   :111.4   Mean   : 88.57   Mean   :5.864   Mean   : 8.977  
##  3rd Qu.:129.0   3rd Qu.: 95.00   3rd Qu.:6.500   3rd Qu.: 8.000  
##  Max.   :160.0   Max.   :145.00   Max.   :9.500   Max.   :45.000  
##       Y.c       
##  Min.   :62.23  
##  1st Qu.:67.44  
##  Median :73.22  
##  Mean   :74.36  
##  3rd Qu.:80.91  
##  Max.   :89.70
ggplotly(ggplot(data.c1, aes(x = Syst, y = Y.c))+geom_point()+labs(title = "Syst vs. Y"))

Lo que se está haciendo en realidad es tomar los centros de las observaciones de cada variable predictora como representantes de cada rectángulo de la agrupación rectangular formada por la variable predictora y la variable dependiente del modelo de regresión.

Gráficamente:

modelo1 <- sym.lm(Pulse ~ ., sym.data = cardiologicalv2 , method = "cm") 
ypred1 <- sym.predict(modelo1, cardiologicalv2)

#length <- cardiologicalv2[c('Syst')]
length1 <- data.frame(lengthmin=c(90,90,140,110,90,130,60,130,110,138,67,56,78,56,56,90,89,89,78,78,78,90,90,90,140,110,90,130,60,130,110,138,67,56,78,56,56,90,89,89,78,78,78,90),lengthmax=c(100,130,180,142,100,160,100,160,190,180, 89,100,130,89,142,89,160,90,160,89,180,150,100,130,180,142,100,160,100,160,190,180,89,100,130,89,142,89,160,90,160,89,180,150))

clusters1 <- cbind(length1,ypred1$Fitted)
colnames(clusters1) <- c('lengthmin','lengthmax','ymin','ymax')
rectangulos1 <- ggplot() + geom_rect(data = clusters1,
    aes(xmin = lengthmin, xmax = lengthmax, ymin = ymin, ymax = ymax),
    fill = "blue", alpha = 0.1, color = "black"
  ) +
  labs(
    title = "Agrupación rectangular",
    x = "Syst",
    y = "Y"
  ) +
  theme_minimal()

graf1 <- rectangulos1 + 
  geom_point(
    data = clusters1, 
    aes(x = (lengthmin+lengthmax)/2, y = (ymin+ymax)/2), 
    color = "orange", size = 3, alpha = 0.9
  )

graf1 

ggplotly(graf1)

Luego, se calcula el índice de bondad de ajuste geométrico.

indice1 <- spatgeom(y=data.c1$Y.c, x=data.c1[,-5])
## Running with x and y
## Index estimation
## Estimating R2 Geom for variable = 1
## Estimating R2 Geom for variable = 2
## Estimating R2 Geom for variable = 3
## Estimating R2 Geom for variable = 4
plot_curve(indice1, type = "curve")

plot_curve(indice1, type = "deriv")

9.2 Método de centros y rangos.

Ahora, además de la matriz de centros se crea la matriz de rangos y se estudian los centros más rangos y los centros menos rangos.

data.r <- interval.ranges(data) 
data.cmasr <- data.c + data.r
data.cmenosr <- data.c - data.r

Se crea un modelo de regresión lineal clásico con los centros más rangos.

modelo.cmasr <- lm(Pulse~., data.cmasr)

El modelo es \(Y=68.3611 + 0.1158X_{1}+0.1557X_{2}-1.9050X_{3}+0.2077X_{4}\)

Y.cmasr <- modelo.cmasr$fitted.values 

Luego, se estudia la contribución de cada variable predictora al modelo a través del diagrama de dispersión asociado.

9.3 Variable Syst.

data.cmasr1 <- cbind(data.cmasr[,-1],Y.cmasr)
ggplot(data.cmasr1, aes(x = Syst, y = Y.cmasr))+geom_point()+labs(title = "Syst vs. Y") #Nube de puntos LENGTH vs Y.cmasr

modelo2 <- sym.lm(Pulse ~ ., sym.data = cardiologicalv2, method = "crm") 
ypred2 <- sym.predict(modelo2, cardiologicalv2)

clusters2 <- cbind(length1,ypred2$Fitted)
colnames(clusters2) <- c('lengthmin','lengthmax','ymin','ymax')

rectangulos2 <- ggplot() + geom_rect(data = clusters2,
    aes(xmin = lengthmin, xmax = lengthmax, ymin = ymin, ymax = ymax),
    fill = "blue", alpha = 0.1, color = "black"
  ) +
  labs(
    title = "Agrupación rectangular",
    x = "Syst",
    y = "Y"
  ) +
  theme_minimal()

graf2 <- rectangulos2 + 
  geom_point(
    data = clusters2, 
    aes(x = lengthmax, y = ymax), 
    color = "red", size = 3, alpha = 0.9
  )

graf2

ggplotly(graf2)
indice2 <- spatgeom(y=data.cmasr1$Y.cmasr, x=data.cmasr1[,-5]) 
## Running with x and y
## Index estimation
## Estimating R2 Geom for variable = 1
## Estimating R2 Geom for variable = 2
## Estimating R2 Geom for variable = 3
## Estimating R2 Geom for variable = 4
plot_curve(indice2, type = "curve")

plot_curve(indice2, type = "deriv")

Se repite lo anterior, pero ahora usando centros menos rangos.

modelo.cmenosr <- lm(Pulse ~., data.cmenosr)

El modelo es \(Y=32.6549+0.1821X_{1}+0.2440X_{2}-2.0934X_{3}+2913X_{4}\)

Y.cmenosr <- modelo.cmenosr$fitted.values 
data.cmenosr1 <- cbind(data.cmenosr[,-1],Y.cmenosr)
ggplot(data.cmenosr1, aes(x = Syst, y = Y.cmenosr))+geom_point()+labs(title = " Syst vs. Y") 

modelo3 <- sym.lm(Pulse ~ ., sym.data = cardiologicalv2, method = "crm") 
ypred3 <- sym.predict(modelo3, cardiologicalv2)

clusters3 <- cbind(length1,ypred3$Fitted)
colnames(clusters3) <- c('lengthmin','lengthmax','ymin','ymax')

rectangulos3 <- ggplot() + geom_rect(data = clusters3,
    aes(xmin = lengthmin, xmax = lengthmax, ymin = ymin, ymax = ymax),
    fill = "blue", alpha = 0.1, color = "black"
  ) +
  labs(
    title = "Agrupación rectangular",
    x = "Syst",
    y = "Y"
  ) +
  theme_minimal()

graf3 <- rectangulos3 + 
  geom_point(data = clusters3, 
    aes(x = lengthmin, y = ymin), 
    color = "green", size = 3, alpha = 0.9
  )

graf3

ggplotly(graf3)
indice3 <- spatgeom(y=data.cmenosr1$Y.cmenosr, x=data.cmenosr1[,-5]) 
## Running with x and y
## Index estimation
## Estimating R2 Geom for variable = 1
## Estimating R2 Geom for variable = 2
## Estimating R2 Geom for variable = 3
## Estimating R2 Geom for variable = 4
plot_curve(indice3, type = "curve")

plot_curve(indice3, type = "deriv")

9.3.1 Gráfica final para la variable Syst con el método de centros y rangos.

geom_indicesc <- indice1$results[[1]]$geom_indices #centros

geom_indicescmasr <- indice2$results[[1]]$geom_indices #centrosmasrangos
geom_indicescmasr1 <- geom_indicescmasr %>% group_by(alpha) %>% filter(geom_corr==max(geom_corr)) %>% ungroup() #Selección de los valores únicos de alpha, considerando el mínimo valor asociado en geom_corr
ggplot(geom_indicescmasr1, aes(x=alpha,y=geom_corr))+geom_point()

geom_indicescmenosr <- indice3$results[[1]]$geom_indices #centrosmenosrangos
geom_indicescmenosr1 <- geom_indicescmenosr %>% group_by(alpha) %>% filter(geom_corr==max(geom_corr)) %>% ungroup() #Selección de los valores únicos de alpha, considerando el máximo valor asociado en geom_corr
ggplot(geom_indicescmenosr1, aes(x=alpha,y=geom_corr))+geom_point()

geom_indicesc$label <- "centers"
geom_indicescmasr$label <- "centers plus ranges"
geom_indicescmenosr$label <- "centers minus ranges"


data_combined <- rbind(geom_indicesc,geom_indicescmasr, geom_indicescmenosr )
data_combined1 <- rbind(geom_indicescmasr1, geom_indicescmenosr1)

# Crear el gráfico
ggplotly(ggplot(data_combined, aes(x = alpha, y = geom_corr, color = label)) +
  geom_step(size = 1) +
  labs(
    title = "",
    x = "Alpha",
    y = "Geom_corr",
    color = "Curve"
  ) +
  theme_minimal() +
  theme(legend.position = "bottom"))

Nota. En los casos en que alpha no cambia, para la curva centros menos rangos se debe utilizar el máximo valor de y, mientras que para la curva centros más rangos, se utilizará centros menos rangos. Todo esto para calcular la integral.

library(pracma)

alpha.vals <- sort(unique(c(geom_indicescmasr1$alpha, geom_indicescmenosr1$alpha)))

geom_corr.cmasr <- approx(geom_indicescmasr1$alpha, geom_indicescmasr1$geom_corr, xout = alpha.vals, rule = 2)$y
geom_corr.cmenosr <- approx(geom_indicescmenosr1$alpha, geom_indicescmenosr1$geom_corr, xout = alpha.vals, rule = 2)$y
diff.geom_corr <- geom_corr.cmasr - geom_corr.cmenosr

table.cmasr <- cbind(alpha.vals, geom_corr.cmasr)
#ggplot(table.cmasr, aes(x=alpha.vals, geom_corr.cmasr))+geom_point()
table.cmenosr <- cbind(alpha.vals, geom_corr.cmenosr)
#ggplot(table.cmenosr, aes(x=alpha.vals, geom_corr.cmenosr))+geom_point()
table.diff <- cbind(alpha.vals, diff.geom_corr)
#ggplot(table.diff, aes(x=alpha.vals, diff.geom_corr))+geom_point()

area.acumulada <- cumsum(c(0, diff.geom_corr[-1] * diff(alpha.vals)))
area.acumulada
##  [1] 0.000000e+00 4.848795e-05 2.657340e-04 1.800041e-03 1.518320e-02
##  [6] 2.804019e-02 2.876162e-02 2.930714e-02 2.958858e-02 2.996462e-02
## [11] 3.163963e-02 3.411002e-02 3.595149e-02 4.025150e-02 4.376838e-02
## [16] 5.260108e-02 6.047286e-02 6.895302e-02 8.807972e-02 1.227884e-01
## [21] 1.227884e-01 1.238813e-01 1.508705e-01 1.691103e-01 1.942478e-01
## [26] 2.038283e-01 2.453912e-01 2.709188e-01 2.709188e-01 3.262522e-01
## [31] 4.504013e-01 4.528516e-01 4.578359e-01 4.630234e-01 4.712916e-01
## [36] 4.822705e-01 4.822705e-01 4.855728e-01 4.934812e-01 5.120535e-01
## [41] 5.143865e-01 5.216714e-01 5.338691e-01 5.338691e-01 6.204609e-01
## [46] 7.104424e-01 8.042832e-01 9.567134e-01 1.444200e+00 1.450849e+00
## [51] 1.455554e+00 1.493681e+00 1.514319e+00 1.514319e+00 1.571764e+00
## [56] 1.608208e+00 1.797918e+00 2.485058e+00 3.201757e+00 3.270675e+00
## [61] 3.385113e+00 3.778692e+00 4.232924e+00 4.624609e+00
data.acumulada <- data.frame(alpha = alpha.vals, area = area.acumulada)
data.acumulada
##        alpha         area
## 1   1.402994 0.000000e+00
## 2   1.800061 4.848795e-05
## 3   2.278057 2.657340e-04
## 4   3.214698 1.800041e-03
## 5   4.525922 1.518320e-02
## 6   5.523881 2.804019e-02
## 7   5.565270 2.876162e-02
## 8   5.601771 2.930714e-02
## 9   5.619691 2.958858e-02
## 10  5.660178 2.996462e-02
## 11  5.748418 3.163963e-02
## 12  5.824925 3.411002e-02
## 13  5.872613 3.595149e-02
## 14  5.955429 4.025150e-02
## 15  6.010835 4.376838e-02
## 16  6.122968 5.260108e-02
## 17  6.220597 6.047286e-02
## 18  6.322232 6.895302e-02
## 19  6.538381 8.807972e-02
## 20  6.904634 1.227884e-01
## 21  6.904634 1.227884e-01
## 22  6.916158 1.238813e-01
## 23  7.250422 1.508705e-01
## 24  7.498996 1.691103e-01
## 25  7.791582 1.942478e-01
## 26  7.902273 2.038283e-01
## 27  8.328997 2.453912e-01
## 28  8.577123 2.709188e-01
## 29  8.577123 2.709188e-01
## 30  9.039883 3.262522e-01
## 31 10.042179 4.504013e-01
## 32 10.062766 4.528516e-01
## 33 10.107478 4.578359e-01
## 34 10.156082 4.630234e-01
## 35 10.237990 4.712916e-01
## 36 10.363750 4.822705e-01
## 37 10.363750 4.822705e-01
## 38 10.403056 4.855728e-01
## 39 10.467604 4.934812e-01
## 40 10.598278 5.120535e-01
## 41 10.614784 5.143865e-01
## 42 10.670498 5.216714e-01
## 43 10.759023 5.338691e-01
## 44 10.759023 5.338691e-01
## 45 11.325317 6.204609e-01
## 46 11.823928 7.104424e-01
## 47 12.311073 8.042832e-01
## 48 13.039666 9.567134e-01
## 49 15.011901 1.444200e+00
## 50 15.038705 1.450849e+00
## 51 15.061173 1.455554e+00
## 52 15.251618 1.493681e+00
## 53 15.357607 1.514319e+00
## 54 15.357607 1.514319e+00
## 55 15.761095 1.571764e+00
## 56 16.007865 1.608208e+00
## 57 17.024864 1.797918e+00
## 58 21.191968 2.485058e+00
## 59 25.450041 3.201757e+00
## 60 25.889604 3.270675e+00
## 61 26.442008 3.385113e+00
## 62 30.509817 3.778692e+00
## 63 35.455139 4.232924e+00
## 64 40.465624 4.624609e+00
p <- ggplot(data.acumulada, aes(x = alpha, y = area.acumulada)) +
  geom_line(size = 1, color = "blue") +
  labs(
    title = "Área Acumulada entre las Curvas",
    x = "Alpha",
    y = "Área Acumulada"
  ) +
  theme_minimal()

ggplotly(p)
#Derivada.

tasa.cambio <- diff(area.acumulada) / diff(alpha.vals)
alpha.medios <- (alpha.vals[-1] + alpha.vals[-length(alpha.vals)])/2
data.derivada <- data.frame(alpha = alpha.medios, tasadecambio = tasa.cambio)

p.derivada <- ggplot(data.derivada, aes(x = alpha, y = tasa.cambio)) +
  geom_line(size = 1, color = "red") +
  labs(
    title = "Tasa de Cambio de la Función Acumulada",
    x = "Alpha",
    y = "Derivada (Tasa de Cambio)"
  ) +
  theme_minimal()

ggplotly(p.derivada)

Probar modelos teóricos, datos de tipo intervalo que sigan cierto tipo de distribución o modelos Doughnout por ejemplo.

Idea: análisis de datos complejos

Idea: bondad de ajuste geométrica para datos de tipo histograma

En 0.7 se intersecan las curvas de pérdida

Buscar un mejor representante en vez del centro, no siempre el centro es el mejor representante.

Workshop PaCMAP.

Combinar PaCMAP con el índice propuesto, separar clusters y buscar el mejor representante por cluster.

El objetivo final es devolver una correlación geométrica en intervalo.

Calcular áreas entre curvas entre mayor es el área entre las curvas entonces más agrupados están los rectángulos (gráficamente uno se puede hacer una idea de la contribución por variable con este valor y con la gráfica de las funciones de pérdida).

Sería importante calcular el valor del área bajo la curva para cada alpha. Hay un alpha ideal que aparece en la función spatgeom.

# Optimización por varianza.
opti.varianza <- function (sym.data, num.dimension) 
{
  N <- sym.data$N
  M <- sym.data$M
  num.dimen.aux <- num.dimension
  seq.min <- seq(from = 1, by = 2, length.out = M)
  seq.max <- seq(from = 2, by = 2, length.out = M)
  sym.var.names <- sym.data$sym.var.names
  sym.data.vertex <- vertex.interval.new.j(sym.data)
  sym.data.vertex.matrix <- sym.data.vertex$vertex
  dim.vertex <- dim(sym.data.vertex.matrix)[1]
  tot.individuals <- N + dim.vertex
  min.interval <- as.vector(as.matrix(sym.data$data[, seq.min]))
  max.interval <- as.vector(as.matrix(sym.data$data[, seq.max]))
  res.min <- nloptr::lbfgs(min.interval, pca.supplementary.vertex.lambda.fun.j, 
    lower = min.interval, upper = max.interval, nl.info = FALSE, 
    control = list(xtol_rel = 1e-08, maxeval = 20000), N = N, 
    M = M, sym.var.names = sym.var.names, sym.data.vertex.matrix = sym.data.vertex.matrix, 
    tot.individuals = tot.individuals, num.dimen.aux = num.dimen.aux)
  M.x <- matrix(res.min$par, nrow = N)
  colnames(M.x) <- sym.var.names
  M.x <- scale(M.x)
  mean.var <- attr(M.x, "scaled:center")
  desv.var <- attr(M.x, "scaled:scale")
  sym.data.vertex.matrix.cent <- sym.data.vertex.matrix
  for (i in 1:M) {
    sym.data.vertex.matrix.cent[, i] <- (sym.data.vertex.matrix.cent[, 
      i] - mean.var[i])/desv.var[i]
  }
  M.x <- rbind(M.x, sym.data.vertex.matrix.cent)
  pca.max <- PCA(X = M.x, scale.unit = FALSE, ind.sup = (N + 
    1):tot.individuals, ncp = M, graph = FALSE)
  pca.min.sym <- sym.interval.pca.limits.new.j(sym.data, pca.max$ind.sup$coord, 
    sym.data.vertex$num.vertex)
  return(list(Sym.Components = pca.min.sym, pca.min = pca.max, 
    res.max = res.min))
}
# Optimización por distancia.
opti.distance <-  function (sym.data) 
{
  N <- sym.data$N
  M <- sym.data$M
  seq.min <- seq(from = 1, by = 2, length.out = M)
  seq.max <- seq(from = 2, by = 2, length.out = M)
  sym.var.names <- sym.data$sym.var.names
  sym.data.vertex <- vertex.interval.new.j(sym.data)
  sym.data.vertex.matrix <- sym.data.vertex$vertex
  dim.vertex <- dim(sym.data.vertex.matrix)[1]
  tot.individuals <- N + dim.vertex
  min.interval <- as.vector(as.matrix(sym.data$data[, seq.min]))
  max.interval <- as.vector(as.matrix(sym.data$data[, seq.max]))
  init.point <- as.vector(as.matrix(centers.interval.j(sym.data)$centers))
  res.min <- nloptr::lbfgs(init.point, pca.supplementary.vertex.fun.j, 
    lower = min.interval, upper = max.interval, nl.info = FALSE, 
    control = list(xtol_rel = 1e-08, maxeval = 20000), N = N, 
    M = M, sym.var.names = sym.var.names, sym.data.vertex.matrix = sym.data.vertex.matrix, 
    tot.individuals = tot.individuals)
  M.x <- matrix(res.min$par, nrow = N)
  colnames(M.x) <- sym.var.names
  M.x <- scale(M.x)
  mean.var <- attr(M.x, "scaled:center")
  desv.var <- attr(M.x, "scaled:scale")
  sym.data.vertex.matrix.cent <- sym.data.vertex.matrix
  for (i in 1:M) {
    sym.data.vertex.matrix.cent[, i] <- (sym.data.vertex.matrix.cent[, 
      i] - mean.var[i])/desv.var[i]
  }
  M.x <- rbind(M.x, sym.data.vertex.matrix.cent)
  pca.min <- FactoMineR::PCA(X = M.x, scale.unit = FALSE, 
    ind.sup = (N + 1):tot.individuals, ncp = M, graph = FALSE)
  pca.min.sym <- sym.interval.pca.limits.new.j(sym.data, pca.min$ind.sup$coord, 
    sym.data.vertex$num.vertex)
  return(list(Sym.Components = pca.min.sym, pca.min = pca.min, 
    res.min = res.min))
}

9.4 Primer intento, Método Best Point.

Primero, se tiene una tabla de datos simbólica de tipo intervalo, por ejemplo abalone de RSDA. Se obtiene la matriz de vértices asociada.

library(RSDA)
datos <- abalone
#Número de vértices de la tabla abalone:
nv <- (2^{dim(datos)[2]})*dim(datos)[1] #3072

#RSDA:::sym.umap.symbolic_tbl() 
#RSDA:::expand_rows

vertex <- function(df){
  l <- lapply(seq_len(ncol(df)), function(x) list(1, 2))
  df_i <- expand.grid(l)
  funs <- list(min, max)
  funs <- lapply(df_i, function(i) funs[unlist(i)])
  out <- lapply(seq_len(nrow(df)), function(i) {
    fila <- df[i, ]
    out <- lapply(seq_along(funs), function(i) {
      unlist(lapply(funs[[i]], function(.f) .f(fila[[i]])))
    })
    out <- as.data.frame(do.call(cbind.data.frame, out))
    colnames(out) <- colnames(df)
    return(out)
  })
  out <- as.data.frame(do.call(rbind.data.frame, out))
  colnames(out) <- colnames(df)
  return(out)
} #Esta es la funcióne expand_rows del código base de sym.umap

datos.v <- vertex(datos)
datos.v <- round(datos.v, 2)

#Qué pasa si aplico un modelo de regresión para los vértices
modelo.vertices <- lm(WHOLE_WEIGHT ~., datos.v)
Y.v <- modelo.vertices$fitted.values 
Y.v <- round(Y.c,2)

Para la variable LENGTH, se tiene la nube de puntos:

#datos.v1 <- cbind(datos.v[,-4],Y.v) 
#indice1 <- spatgeom(y=datos.v1$Y.v, x=datos.v1[,-7])
#plot_curve(indice1, type = "curve")
#plot_curve(indice1, type = "deriv")